105 lines
2.7 KiB
OCaml
105 lines
2.7 KiB
OCaml
open Ast
|
|
|
|
module S = Set.Make(String)
|
|
|
|
exception Expected of string
|
|
exception Unexpected_token of string
|
|
|
|
let expected t =
|
|
raise (Expected t)
|
|
|
|
let unexpected_token t =
|
|
raise @@ Unexpected_token (Token.to_string t)
|
|
|
|
(* precedence table.
|
|
* my first thought was using some sort of partially-ordered graph for
|
|
* precedency, but infering precedence relation from the graph is hard
|
|
* and the graph can be made to have loops, I just used plain table. *)
|
|
let precedence = [
|
|
Add, 10;
|
|
Sub, 10;
|
|
Mul, 20;
|
|
Div, 20;
|
|
] |> List.to_seq |> Hashtbl.of_seq
|
|
|
|
let precedence_of op =
|
|
Hashtbl.find precedence op
|
|
|
|
let is_left_to_right = function
|
|
| Add | Sub | Mul | Div -> true
|
|
|
|
let token_to_op = function
|
|
| Token.Plus -> Add
|
|
| Minus -> Sub
|
|
| Asterisk -> Mul
|
|
| Slash -> Div
|
|
| _ -> failwith "Parser.token_to_op"
|
|
|
|
let parse ts =
|
|
(* value := int | ( expr ) *)
|
|
let rec value seq =
|
|
match seq () with
|
|
| Seq.Nil -> assert false
|
|
| Seq.Cons (x, seq) -> begin match x with
|
|
| Token.Int n -> Value (Int n), 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
|
|
| Token.Plus | Minus | Asterisk | Slash 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
|
|
|
|
and ident set seq =
|
|
match seq () with
|
|
| Seq.Nil ->
|
|
let msg = "ident " ^ (S.elements set |> String.concat " or ") in
|
|
expected msg
|
|
| Seq.Cons (x, seq) -> begin match x with
|
|
| Token.Ident id when S.mem id set -> id, seq
|
|
| _ -> unexpected_token x
|
|
end
|
|
|
|
and operator seq =
|
|
match seq () with
|
|
| Seq.Nil -> expected "operator"
|
|
| Seq.Cons (x, seq) ->
|
|
try token_to_op x, seq with
|
|
| _ -> expected "operator"
|
|
|
|
and level seq =
|
|
let id, seq = ident (S.of_list ["get"; "set"]) seq in
|
|
let op, seq = operator seq in
|
|
if id = "get" then
|
|
Get_binop_pre op, seq
|
|
else
|
|
let v, seq = value seq in
|
|
Set_binop_pre (op, v), seq
|
|
|
|
and expr seq =
|
|
match seq () with
|
|
| Seq.Nil -> Value Unit, Seq.empty (* nop *)
|
|
| Seq.Cons (x, s) -> begin match x with
|
|
| Ident "level" -> level s
|
|
| _ ->
|
|
let left, seq = value seq in
|
|
binop ~-1 left seq
|
|
end
|
|
in
|
|
let ast, rest = expr ts in
|
|
if rest () <> Seq.Nil then failwith "Parser.parse";
|
|
ast
|