open Ast

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)

let precedence = [
  "+", 10;
  "-", 10;
  "*", 20;
  "/", 20;
] |> List.to_seq |> Hashtbl.of_seq

let precedence_of op =
  Hashtbl.find precedence (Ast.binop_to_string op)

let token_to_op = function
  | Token.Plus -> Add
  | Minus -> Sub
  | Asterisk -> Mul
  | Slash -> Div
  | _ -> failwith "Parser.token_to_op"

let parse : type a. Token.t Seq.t -> a Ast.t = fun 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
            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 operator seq =
    match seq () with
    | Seq.Nil -> expected "operator"
    | Seq.Cons (x, seq) ->
      try token_to_op x, seq with
      | _ -> expected "operator"

  and set_conf seq =
    match seq () with
    | Seq.Nil -> expected "ident"
    | Seq.Cons (x, seq) -> begin match x with
        | Token.Ident "level" ->
          let op, seq = operator seq in
          let v, seq = value seq in
          Set_binop_pre (op, v), seq
        | _ -> expected "argument"
      end

  and expr seq =
    match seq () with
    | Seq.Nil -> Value Unit (* nop *)
    | Seq.Cons (x, s) -> begin match x with
        | Ident "set" -> set_conf s
        | _ ->
          let left, seq = value seq in
          binop ~-1 left seq
      end
  in
  let ast, _ = expr ts in
  (*
  if rest () <> Seq.Nil then failwith "Parser.parse";
     *)
  ast