teyalem/ce
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Rework Binary Expression Parser

Browse source
This commit is contained in:
백현웅 2022-01-19 02:10:34 +09:00
parent aba76688be
commit 8e249614ee
2 changed files with 20 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
ast.ml
View file

@ -41,6 +41,7 @@ module Value = struct
end end
(* binary operator *) (* binary operator *)
(* binary operator has type 'a -> 'a -> 'b. *)
module Binop = struct module Binop = struct
type t = type t =
| Add | Sub | Mul | Div (* arithmetics *) | Add | Sub | Mul | Div (* arithmetics *)

38
parser.ml
View file

@ -5,6 +5,7 @@ module S = Set.Make(String)
exception Expected of string exception Expected of string
exception Unexpected_token of string exception Unexpected_token of string
exception End_of_tokens
let expected t = let expected t =
raise @@ Expected t raise @@ Expected t
@ -28,9 +29,9 @@ let precedence = [
let precedence_of op = let precedence_of op =
Hashtbl.find precedence op Hashtbl.find precedence op
let is_left_to_right = function let op_is_right_to_left = function
| Add | Sub | Mul | Div -> true | Exp -> true
| _ -> assert false | _ -> false
let operators = [ let operators = [
Token.Plus, Add; Token.Plus, Add;
@ -45,6 +46,9 @@ let token_to_op tok =
try Hashtbl.find operators tok try Hashtbl.find operators tok
with _ -> failwith "Parser.token_to_op" with _ -> failwith "Parser.token_to_op"
let token_is_operator tok =
Hashtbl.mem operators tok
(* common parsers *) (* common parsers *)
let idents set seq = let idents set seq =
@ -82,10 +86,10 @@ let parse ts =
(* value := int | ( expr ) *) (* value := int | ( expr ) *)
let rec value seq = let rec value seq =
match seq () with match seq () with
| Seq.Nil -> assert false | Seq.Nil -> raise End_of_tokens
| 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
| Token.Float n -> Value (Float n), seq | Float n -> Value (Float n), seq
| LParen -> expr seq | LParen -> expr seq
| _ -> unexpected_token x | _ -> unexpected_token x
end end
@ -95,29 +99,22 @@ let parse ts =
match seq () with match seq () with
| Seq.Nil -> left, Seq.empty | Seq.Nil -> left, Seq.empty
| Seq.Cons (x, seq) -> begin match x with | Seq.Cons (x, seq) -> begin match x with
| Token.Plus | Minus | Asterisk | Slash | Percent as op -> | op when token_is_operator op ->
let op = token_to_op op in let op = token_to_op op in
let o = precedence_of op in let o = precedence_of op in
if o > pre then (* op has to be calculated first *) (* op has to be calculated first *)
if o > pre || op_is_right_to_left op && o = pre then
let v, seq = value seq in let v, seq = value seq in
let right, seq = binop o v seq in let right, seq = binop o v seq in
binop pre (Ast.binop left op right) seq binop pre (Ast.binop left op right) seq
else else
left, Seq.cons x seq left, Seq.cons x seq
| Carret as op -> | Token.RParen -> left, seq
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 | _ -> unexpected_token x
end end
and level _ seq = (* level_inner := "get" | "set" [op] *)
and level_inner _ seq =
let id, seq = idents (S.of_list ["get"; "set"]) seq in let id, seq = idents (S.of_list ["get"; "set"]) seq in
let op, seq = operator seq in let op, seq = operator seq in
if id = "get" then if id = "get" then
@ -128,9 +125,12 @@ let parse ts =
else else
failwith "Parser.level" failwith "Parser.level"
(* expr := "level" level_inner
* | value binop_right
*)
and expr seq = and expr seq =
seq |> either seq |> either
(ident "level" @> level) (ident "level" @> level_inner)
(value @> binop ~-1) (value @> binop ~-1)
in in
let ast, rest = expr ts in let ast, rest = expr ts in