res_parser.ml

module Scanner = Res_scanner
module Diagnostics = Res_diagnostics
module Token = Res_token
module Grammar = Res_grammar
module Reporting = Res_reporting

module Comment = Res_comment

type mode = ParseForTypeChecker | Default

type regionStatus = Report | Silent

type t = {
  mode: mode;
  mutable scanner: Scanner.t;
  mutable token: Token.t;
  mutable startPos: Lexing.position;
  mutable endPos: Lexing.position;
  mutable prevEndPos: Lexing.position;
  mutable breadcrumbs: (Grammar.t * Lexing.position) list;
  mutable errors: Reporting.parseError list;
  mutable diagnostics: Diagnostics.t list;
  mutable comments: Comment.t list;
  mutable regions: regionStatus ref list;
}

let err ?startPos ?endPos p error =
  match p.regions with
  | ({contents = Report} as region) :: _ ->
    let d =
      Diagnostics.make
        ~startPos:
          (match startPos with
          | Some pos -> pos
          | None -> p.startPos)
        ~endPos:
          (match endPos with
          | Some pos -> pos
          | None -> p.endPos)
        error
    in
    p.diagnostics <- d :: p.diagnostics;
    region := Silent
  | _ -> ()

let beginRegion p = p.regions <- ref Report :: p.regions
let endRegion p =
  match p.regions with
  | [] -> ()
  | _ :: rest -> p.regions <- rest

let docCommentToAttributeToken comment =
  let txt = Comment.txt comment in
  let loc = Comment.loc comment in
  Token.DocComment (loc, txt)

let moduleCommentToAttributeToken comment =
  let txt = Comment.txt comment in
  let loc = Comment.loc comment in
  Token.ModuleComment (loc, txt)

(* Advance to the next non-comment token and store any encountered comment
   * in the parser's state. Every comment contains the end position of its
   * previous token to facilite comment interleaving *)
let rec next ?prevEndPos p =
  if p.token = Eof then assert false;
  let prevEndPos =
    match prevEndPos with
    | Some pos -> pos
    | None -> p.endPos
  in
  let startPos, endPos, token = Scanner.scan p.scanner in
  match token with
  | Comment c ->
    if Comment.isDocComment c then (
      p.token <- docCommentToAttributeToken c;
      p.prevEndPos <- prevEndPos;
      p.startPos <- startPos;
      p.endPos <- endPos)
    else if Comment.isModuleComment c then (
      p.token <- moduleCommentToAttributeToken c;
      p.prevEndPos <- prevEndPos;
      p.startPos <- startPos;
      p.endPos <- endPos)
    else (
      Comment.setPrevTokEndPos c p.endPos;
      p.comments <- c :: p.comments;
      p.prevEndPos <- p.endPos;
      p.endPos <- endPos;
      next ~prevEndPos p)
  | _ ->
    p.token <- token;
    p.prevEndPos <- prevEndPos;
    p.startPos <- startPos;
    p.endPos <- endPos

let nextUnsafe p = if p.token <> Eof then next p

let nextTemplateLiteralToken p =
  let startPos, endPos, token = Scanner.scanTemplateLiteralToken p.scanner in
  p.token <- token;
  p.prevEndPos <- p.endPos;
  p.startPos <- startPos;
  p.endPos <- endPos

let checkProgress ~prevEndPos ~result p =
  if p.endPos == prevEndPos then None else Some result

let make ?(mode = ParseForTypeChecker) src filename =
  let scanner = Scanner.make ~filename src in
  let parserState =
    {
      mode;
      scanner;
      token = Token.Semicolon;
      startPos = Lexing.dummy_pos;
      prevEndPos = Lexing.dummy_pos;
      endPos = Lexing.dummy_pos;
      breadcrumbs = [];
      errors = [];
      diagnostics = [];
      comments = [];
      regions = [ref Report];
    }
  in
  parserState.scanner.err <-
    (fun ~startPos ~endPos error ->
      let diagnostic = Diagnostics.make ~startPos ~endPos error in
      parserState.diagnostics <- diagnostic :: parserState.diagnostics);
  next parserState;
  parserState

let leaveBreadcrumb p circumstance =
  let crumb = (circumstance, p.startPos) in
  p.breadcrumbs <- crumb :: p.breadcrumbs

let eatBreadcrumb p =
  match p.breadcrumbs with
  | [] -> ()
  | _ :: crumbs -> p.breadcrumbs <- crumbs

let optional p token =
  if p.token = token then
    let () = next p in
    true
  else false

let expect ?grammar token p =
  if p.token = token then next p
  else
    let error = Diagnostics.expected ?grammar p.prevEndPos token in
    err ~startPos:p.prevEndPos p error

(* Don't use immutable copies here, it trashes certain heuristics
 * in the ocaml compiler, resulting in massive slowdowns of the parser *)
let lookahead p callback =
  let err = p.scanner.err in
  let ch = p.scanner.ch in
  let offset = p.scanner.offset in
  let lineOffset = p.scanner.lineOffset in
  let lnum = p.scanner.lnum in
  let mode = p.scanner.mode in
  let token = p.token in
  let startPos = p.startPos in
  let endPos = p.endPos in
  let prevEndPos = p.prevEndPos in
  let breadcrumbs = p.breadcrumbs in
  let errors = p.errors in
  let diagnostics = p.diagnostics in
  let comments = p.comments in

  let res = callback p in

  p.scanner.err <- err;
  p.scanner.ch <- ch;
  p.scanner.offset <- offset;
  p.scanner.lineOffset <- lineOffset;
  p.scanner.lnum <- lnum;
  p.scanner.mode <- mode;
  p.token <- token;
  p.startPos <- startPos;
  p.endPos <- endPos;
  p.prevEndPos <- prevEndPos;
  p.breadcrumbs <- breadcrumbs;
  p.errors <- errors;
  p.diagnostics <- diagnostics;
  p.comments <- comments;

  res