From e859d0168336d5415ef171e138e799fcf98f7c45 Mon Sep 17 00:00:00 2001 From: Hyeonung Baek Date: Thu, 20 Jan 2022 01:35:48 +0900 Subject: [PATCH] Move parsers out of Parser.parse --- parser.ml | 102 +++++++++++++++++++++++++++--------------------------- 1 file changed, 51 insertions(+), 51 deletions(-) diff --git a/parser.ml b/parser.ml index 8124f1f..669c155 100644 --- a/parser.ml +++ b/parser.ml @@ -92,59 +92,59 @@ let (@>) f g seq = let a, seq = f seq in g a seq +(* expr := "level" level_inner + * | value binop_right +*) +let rec expr seq = + seq |> either + (ident "level" @> level_inner) + (value @> binop ~-1) + +(* 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 + Get_binop_pre op, seq + else if id = "set" then + let v, seq = value seq in + Set_binop_pre (op, v), seq + else + failwith "Parser.level" + +(* 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 = - (* 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 - - (* 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 = - let id, seq = idents (S.of_list ["get"; "set"]) seq in - let op, seq = operator seq in - if id = "get" then - Get_binop_pre op, seq - else if id = "set" then - let v, seq = value seq in - Set_binop_pre (op, v), seq - else - failwith "Parser.level" - - (* expr := "level" level_inner - * | value binop_right - *) - and expr seq = - seq |> either - (ident "level" @> level_inner) - (value @> binop ~-1) - in let ast, rest = expr ts in if rest () <> Seq.Nil then failwith "Parser.parse"; ast