(* Minimal s-expression parser for Modal syntax *)

open Ast

exception Parse_error of string

let is_space = function ' ' | '\n' | '\t' | '\r' -> true | _ -> false

let tokenize s =
  let buf = Buffer.create 16 in
  let tokens = ref [] in
  let flush () =
    if Buffer.length buf > 0 then (
      tokens := Buffer.contents buf :: !tokens;
      Buffer.clear buf)
  in
  String.iter
    (fun c ->
      match c with
      | '(' | ')' -> flush (); tokens := (String.make 1 c) :: !tokens
      | _ when is_space c -> flush ()
      | _ -> Buffer.add_char buf c)
    s;
  flush (); List.rev !tokens

let parse_tokens tokens =
  let rec parse_list i =
    match List.nth_opt tokens i with
    | Some ")" -> ([], i + 1)
    | None -> raise (Parse_error "Unclosed list")
    | _ ->
        let (node, i') = parse_node i in
        let (rest, j) = parse_list i' in
        (node :: rest, j)
  and parse_node i =
    match List.nth_opt tokens i with
    | Some "(" ->
        let (nodes, j) = parse_list (i + 1) in
        (List nodes, j)
    | Some ")" -> raise (Parse_error "Unexpected )")
    | Some tok -> (Atom tok, i + 1)
    | None -> raise (Parse_error "Unexpected end")
  in
  let (node, i) = parse_node 0 in
  if i <> List.length tokens then raise (Parse_error "Trailing tokens");
  node

let parse s = parse_tokens (tokenize s)