(** General purpose parser combinator library.

    @author Jacob Thomas Errington
    @author Marc-Antoine Ouimet *)

(** {1 Introduction to Parser Combinators}

    This is a hand-made parser combinator system, inspired by Haskell's
    {{:https://hackage.haskell.org/package/parsec} parsec library}. The basic
    idea in parser combinators is to use higher-order functions to manipulate
    {i parsing functions} to build up more complex parsers. The most basic
    type we can give for a parsing function would be something like:

    {[
      type 'a parser = char list -> char list * 'a option
    ]}

    [char list] represents the input stream. We must return a new stream,
    perhaps with some characters removed since we parsed them. The result of
    the parse is parametric. Since parsing may fail, we use a type
    constructor to represent this, namely [option].

    However this design has many shortcomings.

    + Representing the input as a [char list] requires the entire input to be
      buffered in memory. This is wasteful. Instead, we should progressively
      read input as we need it. Therefore in our implementation we use a
      lazily-evaluated persistent sequence.
    + Using [option] to represent failure doesn't give us a means to specify
      what the error is. Instead we use [('a, exn) result] in order to also
      return some information in case of failure.
    + Finally, in order to control backtracking and other parsing features,
      we will need to not only pass around and transform the {i input}, but a
      more general {i parser state}.

    So our parsing function type now looks like:

    {[
      type 'a parser = state -> state * ('a, exn) result
    ]}

    where [state] contains a [Located_token.t Seq.t] for the input as well as
    extra stuff for handling backtracking. This is an instance of the state
    monad as defined in {!Support.State.STATE}.

    {2 Backtracking}

    The naive implementation of the [alt] alternation combinator is to say
    that [alt p1 p2] first runs [p1], and if it fails, runs [p2]. This
    implementation has the major drawback of allowing {i unlimited}
    backtracking. This is undesirable because it results in terrible error
    messages. What we would like is a way to control the backtracking
    behaviour of parsers on a more fine-grained level.

    Instead, the library below is non-backtracking, so it introduces the
    [trying] combinator to selectively enable backtracking. [trying p] runs
    [p], and if [p] fails having even consumed input, then [trying p] can
    still be backtracked out of. The [alt] combinator is implemented like
    this:

    - Run [p1]. If it succeeds, return its result without trying [p2].
    - If [p1] failed without consuming any input, then run [p2].
    - If [p1] failed under a [trying], then run [p2].
    - Otherwise, the error generated by [p1] was fatal, so return it.

    The rationale for this is that it allows the parser writer to commit to a
    parse tree once certain conditions have been met. For example, in Beluga,
    after a [case] keyword, we know for sure that we're parsing a case
    expression. Therefore, if we fail afterwards to parse the scrutinee of
    the case (a synthesizable expression), we should not backtrack out of the
    parser for case expressions.

    {2 Language Design Considerations}

    This parser combinator library is only suited for top-down
    data-independent parsing. That is, tokens are parsed sequentially from
    left to right, and no auxiliary data is accumulated during parsing. This
    means that left-recursive grammars and data-dependent grammars are not
    supported without either rewriting the grammar, or disambiguating and
    rewriting parsed ASTs at a later stage.

    It is best to implement a parser with a pre-defined context-free grammar
    in a language specification document. This grammar may need rewriting to
    eliminate left recursion, assign precedences and associativities using
    recursive descent parsing. *)

open Support
open Beluga_syntax

(** {1 Parser State} *)

(** Abstract parser state definition. *)
module type PARSER_STATE = sig
  (** @closed *)
  include State.STATE

  (** {1 Lexing} *)

  (** The type of token in the finite stream being parsed. *)
  type token

  (** [peek state] is [(state', token_opt)] where [token_opt] is the next
      unconsumed token in [state]. If [token_opt = Option.None], then the end
      of the input stream was reached. Otherwise,
      [token_opt = Option.Some token]. The token is not consumed, meaning
      that [state'] is not advanced to the next token in the stream. *)
  val peek : token option t

  (** [observed state] is like [peek state], but the observed token is
      consumed. *)
  val observe : token option t

  (** [accept state] is [(state', ())] where [state'] is derived from [state]
      by consuming the next token in the input stream. This effectively
      observes and discards the next token in [state]. *)
  val accept : unit t

  (** [insert token state] is [(state', ())] where [state'] is derived from
      [state] by inserting [token] at the beginning of the input stream. That
      is, [token] is the next token in [state']. *)
  val insert : token -> unit t

  (** {1 Locations} *)

  (** The type of locations with which input tokens are annotated. *)
  type location

  (** [next_location state] is [(state', next_location_opt)] where
      [next_location_opt] is the location of the next token in [state]. This
      does not advance the input stream. [next_location_opt = Option.None] at
      the end of the input stream. *)
  val next_location : location option t

  (** [previous_location state] is [(state', previous_location_opt)] where
      [previous_location_opt] is the location of the last token in [state] to
      have been consumed. [previous_location_opt = Option.None] at the
      beginning of the input stream. *)
  val previous_location : location option t

  (** {1 Backtracking} *)

  (** [enable_backtracking state] is [(state', ())] where [state'] has
      backtracking enabled. *)
  val enable_backtracking : unit t

  (** [enable_backtracking state] is [(state', ())] where [state'] has
      backtracking disabled. *)
  val disable_backtracking : unit t

  (** [can_backtrack state] is [(state', flag)] where [flag = true] indicates
      that [state] and [state'] allow backtracking out of an erroneous
      result, and [flag = false] otherwise. *)
  val can_backtrack : bool t

  (** [allow_backtracking_on_error m] is [m'] such that [m' state] is
      [(state', x)] with backtracking enabled in [state'] if
      [x = Result.Error cause]. That is, this combinator enables backtracking
      if [m'] produces an error. Backtracking then needs to be manually
      disabled afterwards. *)
  val allow_backtracking_on_error : ('a, 'e) result t -> ('a, 'e) result t

  (** [with_checkpoint m] is [m'] such that [m' state] marks the current
      state, performs [m], then either

      - discards the marked state if [m state = (state', Result.Ok x)],
      - backtracks to the marked state if
        [m state = (state', Result.Error cause)].

      The output error from [m] is additionally annotated with whether
      backtracking occurred.

      In the case of a parser [m], backtracking can occur if backtracking is
      enabled with {!allow_backtracking_on_error}, or if [m] did not consume
      any input. *)
  val with_checkpoint :
       ('a, 'e) result t
    -> ('a, [> `Backtracked of 'e | `Did_not_backtrack of 'e ]) result t
end

(** Module type definition for elements having location annotations. *)
module type LOCATED = sig
  (** The type of element annotated with a location. *)
  type t

  (** The type of location annotation. *)
  type location

  (** [location e] is the location of [e]. *)
  val location : t -> location
end

(** {2 Constructors} *)

(** Functor creating an instance of {!PARSER_STATE} backed by an immutable
    data structure. *)
module Make_persistent_state (Token : LOCATED) : sig
  include
    PARSER_STATE with type token = Token.t and type location = Token.location

  (** [initial ?initial_location token_sequence] is the persistent parsing
      state with [token_sequence] as input, and [?initial_location] as the
      starting location for the first token in [token_sequence]. It is
      assumed that [token_sequence] is a persistent sequence. To construct a
      persistent sequence, see {!Seq.memoize}. *)
  val initial : ?initial_location:location -> token Seq.t -> state
end

(** {1 Parsers} *)

module type PARSER = sig
  type token

  type location

  type state

  type 'a t = state -> state * ('a, exn) result

  type 'a parser = 'a t

  exception Parser_error of exn

  exception
    Labelled_exception of
      { label : string
      ; cause : exn
      }

  exception No_more_choices of exn list

  exception Expected_end_of_input

  include Monad.MONAD with type 'a t := 'a t

  include Functor.FUNCTOR with type 'a t := 'a t

  include Apply.APPLY with type 'a t := 'a t

  (** [run p state] is [(state', result)] where [result] is the output of
      parsing [p] using [state].

      This is only meant to be used internally, or when defining new parser
      combinators, since it does not prune the parser exception when
      [result = Result.Error exn].

      The end user of a parser should use {!run_exn}. *)
  val run : 'a t -> state -> state * ('a, exn) result

  (** [run_exn p state] is [(state', parsed)] where [parsed] is the object
      parsed from [state] using [p]. A pruned exception is raised if [p]
      fails. *)
  val run_exn : 'a t -> state -> state * 'a

  (** [eval_exn p state] runs [p] on [state] like {!val:run_exn}, and
      discards the output parser state. This is used whenever we do not
      resume parsing from the final parser state, particularly when using the
      {!val:only} combinator since we expect the end of the input stream to
      be reached. *)
  val eval_exn : 'a t -> state -> 'a

  (** [catch p] runs [p] and invokes the given handler to modify the outcome.
      Despite being called "catch", this parser is actually a kind of [map],
      and is used to implement "low-level" parser transformations. *)
  val catch :
    'a t -> (state * ('a, exn) result -> state * ('b, exn) result) -> 'b t

  (** [fail exn] is the parser that always fails with [exn]. *)
  val fail : exn -> 'a t

  (** [fail_at_location location exn] is the parser that always fails with
      [exn] annotated with [location]. *)
  val fail_at_location : Location.t -> exn -> 'a t

  (** [fail_at_next_location exn] is the parser that always fails with [exn]
      annotated with the next location in the input stream. *)
  val fail_at_next_location : exn -> 'a t

  (** [fail_at_previous_location exn] is the parser that always fails with
      [exn] annotated with the previous location in the input stream. *)
  val fail_at_previous_location : exn -> 'a t

  (** [labelled label p] is [p'] such that when [p] fails, [p'] annotates the
      exception with a label for error-reporting. *)
  val labelled : string -> 'a t -> 'a t

  (** [span p] is the parser [p'] that additionally returns the source file
      location that spans the tokens consumed by [p]. *)
  val span : 'a t -> (location * 'a) t

  (** [only p] is the parser [p'] that expects [p] to succeed, then the end
      of input to be reached immediately after. *)
  val only : 'a t -> 'a t

  (** [maybe p] is the parser [p'] that may fail, in which case it returns
      [Option.none]. *)
  val maybe : 'a t -> 'a option t

  (** [void p] is the parser [p'] that discards the result of [p]. *)
  val void : 'a t -> unit t

  (** [many p] is the parser [p'] that parses tokens following the EBNF
      grammar [p*], meaning that it parses [0] or more occurrences of [p]. *)
  val many : 'a t -> 'a list t

  (** [some p] is the parser [p'] that parses tokens following the EBNF
      grammar [p+], meaning that it parses [1] or more occurrences of [p]. *)
  val some : 'a t -> 'a List1.t t

  (** [sep_by0 ~sep p] is the parser [p'] that parses tokens following the
      EBNF grammar [\[p (sep p)*\]], meaning that it parses [0] or more
      occurrences of [p] separated by [sep]. *)
  val sep_by0 : sep:unit t -> 'a t -> 'a list t

  (** [sep_by1 ~sep p] is the parser [p'] that parses tokens following the
      EBNF grammar [p (sep p)+], meaning that it parses [1] or more
      occurrences of [p] separated by [sep]. *)
  val sep_by1 : sep:unit t -> 'a t -> 'a List1.t t

  (** [trying p] is the parser [p'] that enables backtracking in the parser
      state if [p] fails, which signals that the erroneous state can be
      backtracked out of irrespective of the number of consumed tokens. *)
  val trying : 'a t -> 'a t

  (** [choice ps] is the parser [p] that sequentially tries the parsers in
      [p].

      For instance, [choice \[p1; p2\]] first runs [p1]. If it fails, [p2] is
      run if one of the following is true.

      - [p1] failed without consuming any input.
      - [p1] failed with backtracking enabled. Backtracking is enabled by the
        [trying] combinator. *)
  val choice : 'a t List.t -> 'a t

  (** [alt p1 p2] is [choice \[p1; p2\]]. *)
  val alt : 'a t -> 'a t -> 'a t

  (** [satisfy f] is the basic parser [p] that performs an action based on
      whether the next token in the stream satisfies the predicate [f]. The
      parser is advanced only if the next token satisfies [f]. If the next
      token does not satisfy the predicate, then the error is annotated with
      the next token's location. *)
  val satisfy : (token option -> ('a, exn) result) -> 'a t

  (** [eoi] is the parser that expects the end of input to be reached. This
      is either the end of the input string, token stream, or file input
      channel. *)
  val eoi : unit t

  (** [insert_token token] is the parser that inserts [token] as the next
      token to be read from the input stream. *)
  val insert_token : token -> unit t
end

(** {2 Constructors} *)

module Make (State : PARSER_STATE with type location = Location.t) :
  PARSER
    with type state = State.state
     and type token = State.token
     and type location = State.location
