text_parse/parser.ml

module type S = sig
  include Syntax.S
  type t
  val parse: Cursor.t -> t -> t
end

module type Sub_parsers = sig
  type t
  val subparsers: (module S with type t = t) array
end 

let at s e cur ch = if s cur ch then Cursor.find_end e cur else None

let apply_default (type a) (module P: S with type t = a) (acc: a) cursor_default cursor =
  if cursor_default = cursor then acc
  else P.parse (Cursor.sub ~right:(cursor.Cursor.pos) cursor_default) acc

let rec branch: type a. ?idx:int -> a -> Cursor.t -> Cursor.t -> (module S with type t = a) array -> (a * Cursor.t) =
fun ?idx:(i=1) acc cursor_default cursor syntaxes ->
  if Cursor.overran cursor then (apply_default syntaxes.(0) acc cursor_default cursor), cursor
  else
  try let (module P: S with type t = a) = syntaxes.(i) in
      (match at P.s P.e cursor (Cursor.char cursor) with
       | Some right ->
         let acc = apply_default syntaxes.(0) acc cursor_default cursor in
         let acc = P.parse (Cursor.sub ~right cursor) acc in
         let cursor = Cursor.sub ~left:right cursor in
         branch acc cursor cursor syntaxes
       | None | exception Invalid_argument _ -> branch ~idx:(i+1) acc cursor_default cursor syntaxes)
  with Invalid_argument _ ->
    branch acc cursor_default (Cursor.next_char cursor) syntaxes

let rec parse subsyntaxes cursor acc =
  if Cursor.overran cursor then acc
  else
    let acc, cursor = branch acc cursor cursor subsyntaxes in
    parse subsyntaxes cursor acc