Move parsers out of Parser.parse

This commit is contained in:
백현웅 2022-01-20 01:35:48 +09:00
parent 7b9ccd1328
commit e859d01683

View file

@ -92,41 +92,16 @@ let (@>) f g seq =
let a, seq = f seq in
g a seq
(* parse tokens *)
let parse ts =
(* value := int | ( expr ) *)
let rec value seq =
match seq () with
| Seq.Nil -> raise End_of_tokens
| Seq.Cons (x, seq) -> begin match x with
| Token.Int n -> Value (Int n), seq
| Float n -> Value (Float n), seq
| Ident id -> Var id, seq
| LParen -> expr seq
| _ -> unexpected_token x
end
(* expr := "level" level_inner
* | value binop_right
*)
let rec expr seq =
seq |> either
(ident "level" @> level_inner)
(value @> binop ~-1)
(* binop := binop op binop *)
and binop pre left seq =
match seq () with
| Seq.Nil -> left, Seq.empty
| Seq.Cons (x, seq) -> begin match x with
| op when token_is_operator op ->
let op = token_to_op op in
let o = precedence_of op in
(* 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 right, seq = binop o v seq in
binop pre (Ast.binop left op right) seq
else
left, Seq.cons x seq
| Token.RParen -> left, seq
| _ -> unexpected_token x
end
(* level_inner := "get" | "set" [op] *)
and level_inner _ seq =
(* level_inner := "get" | "set" [op] *)
and level_inner _ seq =
let id, seq = idents (S.of_list ["get"; "set"]) seq in
let op, seq = operator seq in
if id = "get" then
@ -137,14 +112,39 @@ let parse ts =
else
failwith "Parser.level"
(* expr := "level" level_inner
* | value binop_right
*)
and expr seq =
seq |> either
(ident "level" @> level_inner)
(value @> binop ~-1)
in
(* value := int | ( expr ) *)
and value seq =
match seq () with
| Seq.Nil -> raise End_of_tokens
| Seq.Cons (x, seq) -> begin match x with
| Token.Int n -> Value (Int n), seq
| Float n -> Value (Float n), seq
| Ident id -> Var id, seq
| LParen -> expr seq
| _ -> unexpected_token x
end
(* binop := binop op binop *)
and binop pre left seq =
match seq () with
| Seq.Nil -> left, Seq.empty
| Seq.Cons (x, seq) -> begin match x with
| op when token_is_operator op ->
let op = token_to_op op in
let o = precedence_of op in
(* 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 right, seq = binop o v seq in
binop pre (Ast.binop left op right) seq
else
left, Seq.cons x seq
| Token.RParen -> left, seq
| _ -> unexpected_token x
end
(* parse tokens *)
let parse ts =
let ast, rest = expr ts in
if rest () <> Seq.Nil then failwith "Parser.parse";
ast