res_core.ml

module Doc = Res_doc
module Grammar = Res_grammar
module Token = Res_token
module Diagnostics = Res_diagnostics
module Comment_table = Res_comments_table
module Res_printer = Res_printer
module Scanner = Res_scanner
module Parser = Res_parser

let mk_loc start_loc end_loc =
  Location.{loc_start = start_loc; loc_end = end_loc; loc_ghost = false}

let rec skip_doc_comments p =
  match Parser.peek p with
  | DocComment _ ->
    Parser.next p;
    skip_doc_comments p
  | _ -> ()

type inline_type_definition = {
  name: string;
  loc: Warnings.loc;
  kind: Parsetree.type_kind;
  params: (Parsetree.core_type * Asttypes.variance) list;
}

type inline_types_context = {
  mutable found_inline_types: inline_type_definition list;
  mutable params: (Parsetree.core_type * Asttypes.variance) list;
  collect_free_type_vars: bool;
}

let extend_current_type_name_path current_type_name_path field_name =
  match current_type_name_path with
  | None -> None
  | Some path -> Some (path @ [field_name])

let inline_type_name_exists inline_types_context inline_type_name =
  inline_types_context.found_inline_types
  |> List.exists (fun inline_type -> inline_type.name = inline_type_name)

let inline_type_param_exists params param_name =
  params
  |> List.exists (fun (param, _) ->
      match param.Parsetree.ptyp_desc with
      | Ptyp_var existing_name -> existing_name = param_name
      | _ -> false)

let maybe_track_inline_type_param inline_types_context name loc =
  match inline_types_context with
  | Some inline_types_context
    when inline_types_context.collect_free_type_vars
         && not (inline_type_param_exists inline_types_context.params name) ->
    inline_types_context.params <-
      inline_types_context.params
      @ [(Ast_helper.Typ.var ~loc name, Asttypes.Invariant)]
  | _ -> ()

let make_inline_record_type_name current_type_name_path inline_types_context
    ~base =
  let extend name = extend_current_type_name_path current_type_name_path name in
  let rec loop suffix =
    let candidate = base ^ suffix in
    match (current_type_name_path, inline_types_context) with
    | Some prefix, Some inline_types_context ->
      let full_name = String.concat "." (prefix @ [candidate]) in
      if inline_type_name_exists inline_types_context full_name then
        loop (suffix ^ "$")
      else extend candidate
    | _ -> extend candidate
  in
  loop ""

let make_inline_record_return_type_name current_type_name_path
    inline_types_context =
  make_inline_record_type_name current_type_name_path inline_types_context
    ~base:"return.type"

let make_inline_record_argument_type_name current_type_name_path
    inline_types_context index =
  make_inline_record_type_name current_type_name_path inline_types_context
    ~base:("arg" ^ string_of_int index)

module Recover = struct
  let default_expr () =
    let id = Location.mknoloc "rescript.exprhole" in
    Ast_helper.Exp.mk (Pexp_extension (id, PStr []))

  let default_type () =
    let id = Location.mknoloc "rescript.typehole" in
    Ast_helper.Typ.extension (id, PStr [])

  let default_pattern () =
    let id = Location.mknoloc "rescript.patternhole" in
    Ast_helper.Pat.extension (id, PStr [])

  let default_module_expr () = Ast_helper.Mod.structure []
  let default_module_type () = Ast_helper.Mty.signature []

  let default_signature_item =
    let id = Location.mknoloc "rescript.sigitemhole" in
    Ast_helper.Sig.extension (id, PStr [])

  let recover_equal_greater p =
    Parser.expect EqualGreater p;
    match Parser.peek p with
    | MinusGreater -> Parser.next p
    | _ -> ()

  let should_abort_list_parse (p : Parser.t) token =
    let rec check breadcrumbs =
      match breadcrumbs with
      | [] -> false
      | (grammar, _) :: rest ->
        if Grammar.is_part_of_list grammar token then true else check rest
    in
    check p.breadcrumbs
end

module Error_messages = struct
  let list_pattern_spread =
    "List pattern matches only supports one `...` spread, at the end.\n\
     Explanation: a list spread at the tail is efficient, but a spread in the \
     middle would create new lists; out of performance concern, our pattern \
     matching currently guarantees to never create new intermediate data."

  let record_pattern_spread =
    "Record rest patterns require a type annotation and a binding name.\n\
     Correct syntax: `...typeName as bindingName`\n\
     Example: `let {name, ...Config.t as rest} = myRecord`"

  let record_pattern_multiple_rest =
    "Record patterns can only have one `...` rest clause.\n\
     Use a single `...typeName as bindingName` clause to capture the remaining \
     fields."
  (* let recordPatternUnderscore = "Record patterns only support one `_`, at the end." *)
  [@@live]

  let array_pattern_spread =
    "Array spread (`...`) is not supported in pattern matches.\n\n\
     Explanation: Allowing `...` here would require creating a new subarray at \
     match time, but for performance reasons pattern matching is guaranteed to \
     never create intermediate data.\n\n\
     Possible solutions:\n\
     - To validate specific elements: Use `if` with length checks and \
     `Array.get`\n\
     - To extract a subarray: Use `Array.slice`"

  let record_expr_spread =
    "Records can only have one `...` spread, at the beginning.\n\
     Explanation: since records have a known, fixed shape, a spread like `{a, \
     ...b}` wouldn't make sense, as `b` would override every field of `a` \
     anyway."

  let record_field_missing_colon =
    "Records use `:` when assigning fields. Example: `{field: value}`"

  let record_pattern_field_missing_colon =
    "Record patterns use `:` when matching fields. Example: `{field: value}`"

  let record_type_field_missing_colon =
    "Record fields in type declarations use `:`. Example: `{field: string}`"

  let dict_field_missing_colon =
    "Dict entries use `:` to separate keys from values. Example: `{\"k\": v}`"

  let labelled_argument_missing_equal =
    "Use `=` to pass a labelled argument. Example: `~label=value`"

  let optional_labelled_argument_missing_equal =
    "Optional labelled arguments use `=?`. Example: `~label=?value`"

  let variant_ident =
    "A polymorphic variant (e.g. #id) must start with an alphabetical letter \
     or be a number (e.g. #742)"

  let experimental_if_let switch_expr =
    Doc.concat
      [
        Doc.text "If-let is currently highly experimental.";
        Doc.line;
        Doc.text "Use a regular `switch` with pattern matching instead:";
        Doc.concat
          [
            Doc.hard_line;
            Doc.hard_line;
            Res_printer.print_expression switch_expr Comment_table.empty;
          ];
      ]
    |> Doc.to_string ~width:80

  let experimental_let_unwrap_rec =
    "let? is not allowed to be recursive. Use a regular `let` or remove `rec`."

  let experimental_let_unwrap_sig =
    "let? is not allowed in signatures. Use a regular `let` instead."

  let type_param =
    "A type param consists of a singlequote followed by a name like `'a` or \
     `'A`"
  let type_var =
    "A type variable consists of a singlequote followed by a name like `'a` or \
     `'A`"

  let attribute_without_node (attr : Parsetree.attribute) =
    let {Asttypes.txt = attr_name}, _ = attr in
    "Did you forget to attach `" ^ attr_name
    ^ "` to an item?\n  Standalone attributes start with `@@` like: `@@"
    ^ attr_name ^ "`"

  let type_declaration_name_longident longident =
    "A type declaration's name cannot contain a module access. Did you mean `"
    ^ Longident.last longident ^ "`?"

  let tuple_single_element = "A tuple needs at least two elements"

  let missing_tilde_labeled_parameter name =
    if name = "" then "A labeled parameter starts with a `~`."
    else "A labeled parameter starts with a `~`. Did you mean: `~" ^ name ^ "`?"

  let string_interpolation_in_pattern =
    "String interpolation is not supported in pattern matching."

  let tagged_template_in_pattern =
    "Tagged template literals are not supported in patterns"

  let object_quoted_field_name name =
    "An object type declaration needs quoted field names. Did you mean \""
    ^ name ^ "\"?"

  let forbidden_inline_record_declaration =
    "An inline record type declaration is only allowed in a variant \
     constructor's declaration or nested inside of a record type declaration"

  let poly_var_int_with_suffix number =
    "A numeric polymorphic variant cannot be followed by a letter. Did you \
     mean `#" ^ number ^ "`?"

  let multiple_inline_record_definitions_at_same_path =
    "Only one inline record definition is allowed per record field. This \
     defines more than one inline record."

  let keyword_field_in_expr keyword_txt =
    "Cannot use keyword `" ^ keyword_txt
    ^ "` as a record field name. Suggestion: rename it (e.g. `" ^ keyword_txt
    ^ "_`)"

  let keyword_field_in_pattern keyword_txt =
    "Cannot use keyword `" ^ keyword_txt
    ^ "` here. Keywords are not allowed as record field names."

  let keyword_field_in_type keyword_txt =
    "Cannot use keyword `" ^ keyword_txt
    ^ "` as a record field name. Suggestion: rename it (e.g. `" ^ keyword_txt
    ^ "_`)\n  If you need the field to be \"" ^ keyword_txt
    ^ "\" at runtime, annotate the field: `@as(\"" ^ keyword_txt ^ "\") "
    ^ keyword_txt ^ "_ : ...`"

  let type_definition_in_function =
    "Type definitions are not allowed inside functions.\n"
    ^ "  Move this `type` declaration to the top level or into a module."

  let spread_children_no_longer_supported =
    "Spreading JSX children is no longer supported."
end

(* Emit a deprecation warning when the legacy [(. ...)] uncurried syntax is
   encountered. Uncurried is the default since ReScript v11, so the leading
   dot is no longer meaningful; we still accept it so dependencies on older
   libraries keep parsing. *)
let warn_uncurried_dot_syntax p ~loc =
  Parser.warn p loc
    (Warnings.Deprecated
       ( "The `(. ...)` uncurried syntax is deprecated. Uncurried is now the \
          default in ReScript — remove the leading dot.",
         loc,
         loc,
         false ))

type argument = {label: Asttypes.arg_label; expr: Parsetree.expression}

type type_parameter = {
  attrs: Ast_helper.attrs;
  label: Asttypes.arg_label;
  typ: Parsetree.core_type;
  start_pos: Lexing.position;
}

type typ_def_or_ext =
  | TypeDef of {
      rec_flag: Asttypes.rec_flag;
      types: Parsetree.type_declaration list;
    }
  | TypeExt of Parsetree.type_extension

type fundef_type_param = {
  attrs: Parsetree.attributes;
  locs: string Location.loc list;
}

type fundef_term_param = {
  p_label: Asttypes.arg_label;
  expr: Parsetree.expression option;
  pat: Parsetree.pattern;
}

(* Single parameter of a function definition  (type a b, x, ~y) *)
type fundef_parameter =
  | TermParameter of fundef_term_param
  | TypeParameter of fundef_type_param

type record_pattern_item =
  | PatUnderscore
  | PatField of Parsetree.pattern Parsetree.record_element
  | PatRest of Parsetree.record_pat_rest

(* [WhenExpr] is an expression followed by a block, such as a condition or a
   switch scrutinee. [GuardExpr] is a switch guard, which the case's [=>]
   follows. *)
type context = OrdinaryExpr | TernaryTrueBranchExpr | WhenExpr | GuardExpr

(* Extracts type and term parameters from a list of function definition
   parameters, keeping the type parameter groups in source order *)
let rec extract_fundef_params ~(type_acc : fundef_type_param list)
    ~(term_acc : fundef_term_param list) (params : fundef_parameter list) :
    fundef_type_param list * fundef_term_param list =
  match params with
  | TermParameter tp :: rest ->
    extract_fundef_params ~type_acc ~term_acc:(tp :: term_acc) rest
  | TypeParameter tp :: rest ->
    extract_fundef_params ~type_acc:(tp :: type_acc) ~term_acc rest
  | [] -> (List.rev type_acc, List.rev term_acc)

let get_closing_token = function
  | Token.Lparen -> Token.Rparen
  | Lbrace -> Rbrace
  | Lbracket -> Rbracket
  | List -> Rbrace
  | Dict -> Rbrace
  | LessThan -> GreaterThan
  | _ -> assert false

let rec go_to_closing closing_token state =
  match (Parser.peek state, closing_token) with
  | Rparen, Token.Rparen
  | Rbrace, Rbrace
  | Rbracket, Rbracket
  | GreaterThan, GreaterThan ->
    Parser.next state;
    ()
  | ((LessThan | GreaterThan) as token), _
    when closing_token <> GreaterThan
         && Parser.peek_binary_operator state != token ->
    Parser.next state;
    go_to_closing closing_token state
  | ((Token.Lbracket | Lparen | Lbrace | List | Dict | LessThan) as t), _ ->
    Parser.next state;
    go_to_closing (get_closing_token t) state;
    go_to_closing closing_token state
  | (Rparen | Token.Rbrace | Rbracket | Eof), _ ->
    () (* TODO: how do report errors here? *)
  | _ ->
    Parser.next state;
    go_to_closing closing_token state

let is_es6_arrow_expression ~in_ternary p =
  match Parser.peek p with
  | Lident "async" | Lparen ->
    Parser.lookahead p (fun state ->
        (match Parser.peek state with
        | Lident "async" -> Parser.next state
        | _ -> ());
        match Parser.peek state with
        | Lident _ | Underscore -> (
          Parser.next state;
          match Parser.peek state with
          | EqualGreater -> true
          | _ -> false)
        | Lparen -> (
          let position = Parser.position state in
          Parser.next state;
          match Parser.peek state with
          (* arrived at `()` here *)
          | Rparen -> (
            Parser.next state;
            match Parser.peek state with
            (* arrived at `() :` here *)
            | Colon when not in_ternary -> (
              Parser.next state;
              match Parser.peek state with
              (* arrived at `() :typ` here *)
              | Lident _ -> (
                Parser.next state;
                (match Parser.peek state with
                (* arrived at `() :typ<` here *)
                | LessThan ->
                  Parser.next state;
                  go_to_closing GreaterThan state
                | _ -> ());
                match Parser.peek state with
                (* arrived at `() :typ =>` or `() :typ<'a,'b> =>` here *)
                | EqualGreater -> true
                | _ -> false)
              | _ -> true)
            | EqualGreater -> true
            | _ -> false)
          | Dot (* uncurried *) -> true
          | Backtick ->
            false
            (* (` always indicates the start of an expr, can't be es6 parameter *)
          | _ -> (
            go_to_closing Rparen state;
            match Parser.peek state with
            | EqualGreater -> true
            (* | Lbrace TODO: detect missing =>, is this possible? *)
            | Colon when not in_ternary -> true
            | Rparen ->
              (* imagine having something as :
               * switch colour {
               * | Red
               *    when l == l'
               *    || (&Clflags.classic && (l == Nolabel && !is_optional(l'))) => (t1, t2)
               * We'll arrive at the outer rparen just before the =>.
               * This is not an es6 arrow.
               *)
              false
            | _ -> (
              Parser.next_unsafe state;
              (* error recovery, peek at the next token,
               * (elements, providerId] => {
               *  in the example above, we have an unbalanced ] here
               *)
              match Parser.peek state with
              | EqualGreater
                when (Parser.start_pos state).pos_lnum == position.pos_lnum ->
                true
              | _ -> false)))
        | _ -> false)
  | Lident _ | Underscore -> Parser.peek2 p = EqualGreater
  | _ -> false

let is_es6_arrow_functor p =
  Parser.peek p = Lparen
  && Parser.lookahead p (fun state ->
      Parser.next state;
      match Parser.peek state with
      | Rparen -> (
        Parser.next state;
        match Parser.peek state with
        | Colon | EqualGreater -> true
        | _ -> false)
      | _ -> (
        go_to_closing Rparen state;
        match Parser.peek state with
        | EqualGreater | Lbrace | Colon -> true
        | _ -> false))

let is_es6_arrow_type p =
  match Parser.peek p with
  | Tilde -> true
  | Lparen ->
    Parser.lookahead p (fun state ->
        Parser.next state;
        match Parser.peek state with
        | Rparen ->
          Parser.next state;
          Parser.peek state = EqualGreater
        | Tilde | Dot -> true
        | _ ->
          go_to_closing Rparen state;
          Parser.peek state = EqualGreater)
  | _ -> false

let build_longident words =
  match List.rev words with
  | [] -> assert false
  | hd :: tl -> List.fold_left (fun p s -> Longident.Ldot (p, s)) (Lident hd) tl

let emit_keyword_field_error (p : Parser.t) ~mk_message =
  let keyword_txt = Token.to_string (Parser.peek p) in
  let keyword_start = Parser.start_pos p in
  let keyword_end = Parser.end_pos p in
  Parser.err ~start_pos:keyword_start ~end_pos:keyword_end p
    (Diagnostics.message (mk_message keyword_txt))

(* Recovers a keyword used as field name if it's probable that it's a full
   field name (not punning etc), by checking if there's a colon after it. *)
let recover_keyword_field_name_if_probably_field p ~mk_message :
    (string * Location.t) option =
  if Token.is_keyword (Parser.peek p) && Parser.peek2 p = Colon then (
    emit_keyword_field_error p ~mk_message;
    let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
    let recovered_field_name = Token.to_string (Parser.peek p) ^ "_" in
    Parser.next p;
    Some (recovered_field_name, loc))
  else None

let make_infix_operator (p : Parser.t) token start_pos end_pos =
  let stringified_token =
    if token = Token.Equal then (
      (* TODO: could have a totally different meaning like x->fooSet(y)*)
      Parser.err ~start_pos ~end_pos p
        (Diagnostics.message "Did you mean `==` here?");
      "=")
    else Token.to_string token
  in
  let loc = mk_loc start_pos end_pos in
  let operator = Location.mkloc (Longident.Lident stringified_token) loc in
  Ast_helper.Exp.ident ~loc operator

let negate_string s =
  if String.length s > 0 && (s.[0] [@doesNotRaise]) = '-' then
    (String.sub [@doesNotRaise]) s 1 (String.length s - 1)
  else "-" ^ s

let make_unary_expr start_pos token_end token operand =
  match (token, operand.Parsetree.pexp_desc) with
  | (Token.Plus | PlusDot), Pexp_constant (Pconst_integer _ | Pconst_float _) ->
    operand
  | Minus, Pexp_constant (Pconst_integer (n, m)) ->
    {
      operand with
      pexp_desc = Pexp_constant (Pconst_integer (negate_string n, m));
    }
  | (Minus | MinusDot), Pexp_constant (Pconst_float (n, m)) ->
    {operand with pexp_desc = Pexp_constant (Pconst_float (negate_string n, m))}
  | (Token.Plus | PlusDot | Minus | MinusDot | Bnot), _ ->
    let token_loc = mk_loc start_pos token_end in
    let token_string = Token.to_string token in
    let operator =
      if token_string.[0] = '~' then token_string else "~" ^ token_string
    in
    Ast_helper.Exp.apply
      ~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end)
      (Ast_helper.Exp.ident ~loc:token_loc
         (Location.mkloc (Longident.Lident operator) token_loc))
      [(Nolabel, operand)]
  | Token.Bang, _ ->
    let token_loc = mk_loc start_pos token_end in
    Ast_helper.Exp.apply
      ~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end)
      (Ast_helper.Exp.ident ~loc:token_loc
         (Location.mkloc (Longident.Lident "not") token_loc))
      [(Nolabel, operand)]
  | _ -> operand

let make_list_pattern loc seq ext_opt =
  let rec handle_seq = function
    | [] ->
      let base_case =
        match ext_opt with
        | Some ext -> ext
        | None ->
          let loc = {loc with Location.loc_ghost = true} in
          let nil = {Location.txt = Longident.Lident "[]"; loc} in
          Ast_helper.Pat.construct ~loc nil (Location.mkloc [] loc)
      in
      base_case
    | p1 :: pl ->
      let pat_pl = handle_seq pl in
      let loc =
        mk_loc p1.Parsetree.ppat_loc.loc_start pat_pl.ppat_loc.loc_end
      in
      Ast_helper.Pat.mk ~loc
        (Ppat_construct
           ( Location.mkloc (Longident.Lident "::") loc,
             {txt = [p1; pat_pl]; loc} ))
  in
  handle_seq seq

(* TODO: diagnostic reporting *)
let lident_of_path longident =
  match Longident.flatten longident |> List.rev with
  | [] -> ""
  | ident :: _ -> ident

(**
  * process the occurrence of _ in the arguments of a function application
  * replace _ with a new variable, currently __x, in the arguments
  * return a wrapping function that wraps ((__x) => ...) around an expression
  * e.g. foo(_, 3) becomes (__x) => foo(__x, 3)
  *)
let process_underscore_application args =
  let exp_question = ref None in
  let hidden_var = "__x" in
  let check_arg ((lab, exp) as arg) =
    match exp.Parsetree.pexp_desc with
    | Pexp_ident ({txt = Lident "_"} as id) ->
      let new_id = Location.mkloc (Longident.Lident hidden_var) id.loc in
      let new_exp = Ast_helper.Exp.mk (Pexp_ident new_id) ~loc:exp.pexp_loc in
      exp_question := Some new_exp;
      (lab, new_exp)
    | _ -> arg
  in
  let args = List.map check_arg args in
  let wrap (exp_apply : Parsetree.expression) =
    match !exp_question with
    | Some {pexp_loc = loc} ->
      let pattern =
        Ast_helper.Pat.mk
          (Ppat_var (Location.mkloc hidden_var loc))
          ~loc:Location.none
      in
      Ast_helper.Exp.fun_ ~loc
        [Ast_helper.Exp.fun_param Nolabel pattern]
        exp_apply
    | None -> exp_apply
  in
  (args, wrap)

(* Transform A.a into a. For use with punned record fields as in {A.a, b}. *)
let remove_module_name_from_punned_field_value exp =
  match exp.Parsetree.pexp_desc with
  | Pexp_ident path_ident ->
    {
      exp with
      pexp_desc =
        Pexp_ident
          {path_ident with txt = Lident (Longident.last path_ident.txt)};
    }
  | _ -> exp

let rec parse_lident p =
  let recover_lident p =
    if
      Token.is_keyword (Parser.peek p)
      && (Parser.position p).pos_lnum == (Parser.start_pos p).pos_lnum
    then (
      Parser.err p (Diagnostics.lident (Parser.peek p));
      Parser.next p;
      None)
    else
      let rec loop p =
        if
          (not (Recover.should_abort_list_parse p (Parser.peek p)))
          && Parser.peek p <> Eof
        then (
          Parser.next p;
          loop p)
      in
      Parser.err p (Diagnostics.lident (Parser.peek p));
      Parser.next p;
      loop p;
      match Parser.peek p with
      | Lident _ -> Some ()
      | _ -> None
  in
  let start_pos = Parser.start_pos p in
  match Parser.peek p with
  | Lident ident ->
    Parser.next p;
    let loc = mk_loc start_pos (Parser.position p) in
    (ident, loc)
  | Eof ->
    Parser.err ~start_pos p
      (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs);
    ("_", mk_loc start_pos (Parser.position p))
  | _ -> (
    match recover_lident p with
    | Some () -> parse_lident p
    | None -> ("_", mk_loc start_pos (Parser.position p)))

let parse_ident ~msg ~start_pos p =
  match Parser.peek p with
  | Lident ident | Uident ident ->
    Parser.next p;
    let loc = mk_loc start_pos (Parser.position p) in
    (ident, loc)
  | token
    when Token.is_keyword token
         && (Parser.position p).pos_lnum == (Parser.start_pos p).pos_lnum ->
    let token_txt = Token.to_string token in
    let msg =
      "`" ^ token_txt
      ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" ^ token_txt
      ^ "\""
    in
    Parser.err ~start_pos p (Diagnostics.message msg);
    Parser.next p;
    (token_txt, mk_loc start_pos (Parser.position p))
  | _token ->
    Parser.err ~start_pos p (Diagnostics.message msg);
    Parser.next p;
    ("", mk_loc start_pos (Parser.position p))

let parse_hash_ident ~start_pos p =
  Parser.expect Hash p;
  match Parser.peek p with
  | String text ->
    Parser.next p;
    (text, mk_loc start_pos (Parser.position p))
  | Int {i; suffix} ->
    let () =
      match suffix with
      | Some _ ->
        Parser.err p
          (Diagnostics.message (Error_messages.poly_var_int_with_suffix i))
      | None -> ()
    in
    Parser.next p;
    (i, mk_loc start_pos (Parser.position p))
  | Eof ->
    Parser.err ~start_pos p
      (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs);
    ("", mk_loc start_pos (Parser.position p))
  | _ -> parse_ident ~start_pos ~msg:Error_messages.variant_ident p

(* Ldot (Ldot (Lident "Foo", "Bar"), "baz") *)
let parse_value_path p =
  let start_pos = Parser.start_pos p in
  let rec aux p path =
    let start_pos = Parser.start_pos p in
    let token = Parser.peek p in

    Parser.next p;
    if Parser.peek p = Dot then (
      Parser.expect Dot p;

      match Parser.peek p with
      | Lident ident -> Longident.Ldot (path, ident)
      | Uident uident -> aux p (Ldot (path, uident))
      | token ->
        Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
        Longident.Ldot (path, "_"))
    else (
      Parser.err p ~start_pos ~end_pos:(Parser.position p)
        (Diagnostics.lident token);
      path)
  in
  let ident =
    match Parser.peek p with
    | Lident ident ->
      Parser.next p;
      Longident.Lident ident
    | Uident ident ->
      let res = aux p (Lident ident) in
      Parser.next_unsafe p;
      res
    | token ->
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      Parser.next_unsafe p;
      Longident.Lident "_"
  in
  Location.mkloc ident (mk_loc start_pos (Parser.position p))

let parse_value_path_after_dot p =
  let start_pos = Parser.start_pos p in
  match Parser.peek p with
  | Lident _ | Uident _ -> parse_value_path p
  | token ->
    Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
    Location.mkloc (Longident.Lident "_") (mk_loc start_pos (Parser.position p))

let parse_value_path_tail p start_pos ident =
  let rec loop p path =
    match Parser.peek p with
    | Lident ident ->
      Parser.next p;
      Location.mkloc
        (Longident.Ldot (path, ident))
        (mk_loc start_pos (Parser.position p))
    | Uident ident ->
      Parser.next p;
      Parser.expect Dot p;
      loop p (Longident.Ldot (path, ident))
    | token ->
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      Location.mkloc
        (Longident.Ldot (path, "_"))
        (mk_loc start_pos (Parser.position p))
  in
  loop p ident

let parse_module_long_ident_tail ~lowercase p start_pos ident =
  let rec loop p acc =
    match Parser.peek p with
    | Lident ident when lowercase ->
      Parser.next p;
      let lident = Longident.Ldot (acc, ident) in
      Location.mkloc lident (mk_loc start_pos (Parser.position p))
    | Uident ident -> (
      Parser.next p;
      let end_pos = Parser.position p in
      let lident = Longident.Ldot (acc, ident) in
      match Parser.peek p with
      | Dot ->
        Parser.next p;
        loop p lident
      | _ -> Location.mkloc lident (mk_loc start_pos end_pos))
    | t ->
      Parser.err p (Diagnostics.uident t);
      Location.mkloc
        (Longident.Ldot (acc, "_"))
        (mk_loc start_pos (Parser.position p))
  in
  loop p ident

(* jsx allows for `-` token in the name, we need to combine some tokens into a single ident *)
(* This function returns Some token when a combined token is created, None when no change is needed.
   When it returns Some token:
   - All immediately following ("-" IDENT) chunks have been consumed from the scanner
   - No hyphen that belongs to the JSX name remains unconsumed
   - The returned token is the combined Lident/Uident for the full name *)
(* Non-mutating helpers to parse JSX identifiers with optional hyphen chains *)
type jsx_ident_kind = [`Lower | `Upper]

(* Inspect current token; do not advance *)
let peek_ident (p : Parser.t) : (string * Location.t * jsx_ident_kind) option =
  match Parser.peek p with
  | Lident txt ->
    Some (txt, mk_loc (Parser.start_pos p) (Parser.end_pos p), `Lower)
  | Uident txt ->
    Some (txt, mk_loc (Parser.start_pos p) (Parser.end_pos p), `Upper)
  | _ -> None

(* Consume one Lident/Uident if present *)
let expect_ident (p : Parser.t) : (string * Location.t * jsx_ident_kind) option
    =
  match peek_ident p with
  | None -> None
  | Some (txt, loc, k) ->
    Parser.next p;
    Some (txt, loc, k)

(* Consume ("-" IDENT)*, appending to buffer; update last_end; diagnose trailing '-' *)
let rec read_hyphen_chain (p : Parser.t) (buf : Buffer.t)
    (last_end : Lexing.position ref) : unit =
  match Parser.peek p with
  | Minus -> (
    Parser.next p;
    (* after '-' *)
    match peek_ident p with
    | Some (txt, _loc, _) ->
      Buffer.add_char buf '-';
      Buffer.add_string buf txt;
      (* consume ident *)
      Parser.next p;
      last_end := Parser.position p;
      read_hyphen_chain p buf last_end
    | None ->
      (* Match previous behavior: rely on parser's current location *)
      Parser.err p
        (Diagnostics.message "JSX identifier cannot end with a hyphen"))
  | _ -> ()

(* Read local jsx name: returns combined name + loc + kind of head ident *)
let read_local_jsx_name (p : Parser.t) :
    (string * Location.t * jsx_ident_kind) option =
  match expect_ident p with
  | None -> None
  | Some (head, head_loc, kind) ->
    let buf = Buffer.create (String.length head + 8) in
    Buffer.add_string buf head;
    let start_pos = head_loc.Location.loc_start in
    let last_end = ref head_loc.Location.loc_end in
    read_hyphen_chain p buf last_end;
    let name = Buffer.contents buf in
    let loc = mk_loc start_pos !last_end in
    Some (name, loc, kind)

(* Build a Longident from a non-empty list of segments *)
let longident_of_segments (segs : string list) : Longident.t =
  match segs with
  | [] -> invalid_arg "longident_of_segments: empty list"
  | hd :: tl ->
    List.fold_left
      (fun acc s -> Longident.Ldot (acc, s))
      (Longident.Lident hd) tl

(* Read a JSX tag name and return a jsx_tag_name; does not mutate tokens beyond what it consumes *)
let read_jsx_tag_name (p : Parser.t) :
    (Parsetree.jsx_tag_name Location.loc, string) result =
  match peek_ident p with
  | None -> Error ""
  | Some (_, _, `Lower) ->
    read_local_jsx_name p
    |> Option.map (fun (name, loc, _) ->
        {Location.txt = Parsetree.JsxLowerTag name; loc})
    |> Option.to_result ~none:""
  | Some (first_seg, first_loc, `Upper) ->
    let start_pos = first_loc.Location.loc_start in
    (* consume first Uident *)
    Parser.next p;
    let string_of_rev_segments segs = String.concat "." (List.rev segs) in
    let rec loop rev_segs last_end =
      match Parser.peek p with
      | Dot -> (
        Parser.next p;
        (* after '.' *)
        match peek_ident p with
        | None ->
          Parser.err p
            (Diagnostics.message "expected identifier after '.' in JSX tag name");
          Error (string_of_rev_segments rev_segs ^ ".")
        | Some (txt, _loc, `Upper) ->
          (* another path segment *)
          Parser.next p;
          loop (txt :: rev_segs) (Parser.position p)
        | Some (_, _, `Lower) -> (
          (* final lowercase with optional hyphens *)
          match read_local_jsx_name p with
          | Some (lname, l_loc, _) -> (
            match rev_segs with
            | [] -> Error ""
            | _ ->
              let path = longident_of_segments (List.rev rev_segs) in
              let loc = mk_loc start_pos l_loc.Location.loc_end in
              Ok
                {
                  Location.txt =
                    Parsetree.JsxQualifiedLowerTag {path; name = lname};
                  loc;
                })
          | None -> Error ""))
      | _ -> (
        (* pure Upper path *)
        match rev_segs with
        | [] -> Error ""
        | _ ->
          let path = longident_of_segments (List.rev rev_segs) in
          let loc = mk_loc start_pos last_end in
          Ok {txt = Parsetree.JsxUpperTag path; loc})
    in
    (* seed with the first segment already consumed *)
    loop [first_seg] first_loc.Location.loc_end

(* Parses module identifiers:
     Foo
     Foo.Bar *)
let parse_module_long_ident ~lowercase p =
  let start_pos = Parser.start_pos p in
  let module_ident =
    match Parser.peek p with
    | Lident ident when lowercase ->
      let loc = mk_loc start_pos (Parser.end_pos p) in
      let lident = Longident.Lident ident in
      Parser.next p;
      Location.mkloc lident loc
    | Uident ident -> (
      let lident = Longident.Lident ident in
      let end_pos = Parser.end_pos p in
      Parser.next p;
      match Parser.peek p with
      | Dot ->
        Parser.next p;
        parse_module_long_ident_tail ~lowercase p start_pos lident
      | _ -> Location.mkloc lident (mk_loc start_pos end_pos))
    | t ->
      Parser.err p (Diagnostics.uident t);
      Location.mkloc (Longident.Lident "_")
        (mk_loc start_pos (Parser.position p))
  in
  module_ident

(* open-def ::=
 *   | open module-path
 *   | open! module-path *)
let parse_open_description ~attrs p =
  Parser.leave_breadcrumb p Grammar.OpenDescription;
  let start_pos = Parser.start_pos p in
  Parser.expect Open p;
  let override =
    if Parser.optional p Token.Bang then Asttypes.Override else Asttypes.Fresh
  in
  let modident = parse_module_long_ident ~lowercase:false p in
  let loc = mk_loc start_pos (Parser.position p) in
  Parser.eat_breadcrumb p;
  Ast_helper.Opn.mk ~loc ~attrs ~override modident

(* constant	::=	integer-literal   *)
(* ∣	 float-literal   *)
(* ∣	 string-literal   *)
let parse_string_constant (p : Parser.t) ~start_pos ~end_pos source =
  match String_literal.string_from_source source with
  | Some payload -> Parsetree.Pconst_string payload
  | None ->
    let has_literal_diagnostic =
      Parser.has_diagnostic p (fun diagnostic ->
          let diagnostic_start = Diagnostics.get_start_pos diagnostic in
          diagnostic_start.Lexing.pos_cnum >= start_pos.Lexing.pos_cnum
          && diagnostic_start.Lexing.pos_cnum <= end_pos.Lexing.pos_cnum)
    in
    if not has_literal_diagnostic then
      Parser.err ~start_pos ~end_pos p
        (Diagnostics.message
           (if String_literal.is_valid_utf8 source then
              "Invalid string escape sequence"
            else "Invalid code point"));
    Parsetree.Pconst_string (String_literal.invalid_string_for_recovery source)

let parse_constant p =
  let is_negative =
    match Parser.peek p with
    | Token.Minus ->
      Parser.next p;
      true
    | Plus ->
      Parser.next p;
      false
    | _ -> false
  in
  let constant =
    match Parser.peek p with
    | Int {i; suffix} ->
      (* Only decimal literal is allowed for bigint *)
      if suffix = Some 'n' && not (Bigint_utils.is_valid i) then
        Parser.err p
          (Diagnostics.message
             "Invalid bigint literal. Only decimal literal is allowed for \
              bigint.");
      let int_txt = if is_negative then "-" ^ i else i in
      Parsetree.Pconst_integer (int_txt, suffix)
    | Float {f; suffix} ->
      let float_txt = if is_negative then "-" ^ f else f in
      Parsetree.Pconst_float (float_txt, suffix)
    | String source ->
      parse_string_constant p ~start_pos:(Parser.start_pos p)
        ~end_pos:(Parser.end_pos p) source
    | Codepoint {c; original} -> Pconst_char {source = original; semantic = c}
    | token ->
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      Ast_helper.Const.string ""
  in
  Parser.next_unsafe p;
  constant

let parse_template_constant ~start_pos ~prefix (p : Parser.t) =
  (* Arrived at the ` char *)
  Parser.next_template_literal_token p;
  match Parser.peek p with
  | TemplateTail (txt, _) -> (
    Parser.next p;
    match prefix with
    | None -> (
      match String_literal.decode_js_template_escapes txt with
      | Some semantic -> Ast_helper.Const.string semantic
      | None ->
        Parser.err ~start_pos ~end_pos:(Parser.position p) p
          (Diagnostics.message "Invalid string escape sequence");
        Ast_helper.Const.string "")
    | Some _ ->
      Parser.err ~start_pos ~end_pos:(Parser.position p) p
        (Diagnostics.message Error_messages.tagged_template_in_pattern);
      Ast_helper.Const.string txt)
  | _ ->
    let rec skip_tokens () =
      if Parser.peek p <> Eof then (
        Parser.next p;
        match Parser.peek p with
        | Backtick ->
          Parser.next p;
          ()
        | _ -> skip_tokens ())
    in
    skip_tokens ();
    Parser.err ~start_pos ~end_pos:(Parser.position p) p
      (Diagnostics.message Error_messages.string_interpolation_in_pattern);
    Ast_helper.Const.string ""

let parse_comma_delimited_reversed_list p ~grammar ~closing ~f =
  Parser.leave_breadcrumb p grammar;
  (* Closing delimiters are constant token constructors. *)
  let rec loop closing parents nodes =
    match f p with
    | Some node -> (
      match Parser.peek p with
      | Comma ->
        Parser.next p;
        loop closing parents (node :: nodes)
      | token when token == closing || token = Eof -> node :: nodes
      | token when Grammar.is_list_element grammar token ->
        (* missing comma between nodes in the region and the current token
         * looks like the start of something valid in the current region.
         * Example:
         *   type student<'extraInfo> = {
         *     name: string,
         *     age: int
         *     otherInfo: 'extraInfo
         *   }
         * There is a missing comma between `int` and `otherInfo`.
         * `otherInfo` looks like a valid start of the record declaration.
         * We report the error here and then continue parsing the region.
         *)
        Parser.expect Comma p;
        loop closing parents (node :: nodes)
      | token ->
        if not (Recover.should_abort_list_parse p token) then
          Parser.expect Comma p;
        if token = Semicolon then Parser.next p;
        loop closing parents (node :: nodes))
    | None -> (
      match Parser.peek p with
      | token when token = Eof || token == closing -> nodes
      | (Lparen | Lbrace | Lbracket | LessThan) as opening ->
        (* Keep unexpected delimiters paired, so their closer does not escape
           into an enclosing grammar. Retain recoverable list elements. *)
        Parser.err p (Diagnostics.unexpected opening p.breadcrumbs);
        Parser.next p;
        let nested_closing = get_closing_token opening in
        let nodes = loop nested_closing (closing :: parents) nodes in
        Parser.expect nested_closing p;
        loop closing parents nodes
      (* Return only closers belonging to a group we are recovering inside. *)
      | (Rparen | Rbrace | Rbracket | GreaterThan) as token
        when List.memq token parents ->
        nodes
      | token when Recover.should_abort_list_parse p token -> nodes
      | token ->
        Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
        Parser.next p;
        loop closing parents nodes)
  in
  let nodes = loop closing [] [] in
  Parser.eat_breadcrumb p;
  nodes

let parse_comma_delimited_region p ~grammar ~closing ~f =
  List.rev (parse_comma_delimited_reversed_list p ~grammar ~closing ~f)

let parse_delimited_region p ~grammar ~closing ~f =
  Parser.leave_breadcrumb p grammar;
  let rec loop nodes =
    match f p with
    | Some node -> loop (node :: nodes)
    | None ->
      let token = Parser.peek p in
      if
        token = Token.Eof || token = closing
        || Recover.should_abort_list_parse p token
      then List.rev nodes
      else (
        Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
        Parser.next p;
        loop nodes)
  in
  let nodes = loop [] in
  Parser.eat_breadcrumb p;
  nodes

let parse_region p ~grammar ~f =
  Parser.leave_breadcrumb p grammar;
  let rec loop nodes =
    match f p with
    | Some node -> loop (node :: nodes)
    | None ->
      let token = Parser.peek p in
      if token = Token.Eof || Recover.should_abort_list_parse p token then
        List.rev nodes
      else (
        Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
        Parser.next p;
        loop nodes)
  in
  let nodes = loop [] in
  Parser.eat_breadcrumb p;
  nodes

(* let-binding	::=	pattern =  expr   *)
(* ∣	 value-name  { parameter }  [: typexpr]  [:> typexpr] =  expr   *)
(* ∣	 value-name :  poly-typexpr =  expr   *)

(* pattern	::=	value-name   *)
(* ∣	 _   *)
(* ∣	 constant   *)
(* ∣	 pattern as  value-name   *)
(* ∣	 ( pattern )   *)
(* ∣	 ( pattern :  typexpr )   *)
(* ∣	 pattern |  pattern   *)
(* ∣	 constr  pattern   *)
(* ∣	 #variant variant-pattern *)
(* ∣	 #...type  *)
(* ∣	 / pattern  { , pattern }+  /   *)
(* ∣	 { field  [: typexpr]  [= pattern] { ; field  [: typexpr]  [= pattern] }  [; _ ] [ ; ] }   *)
(* ∣	 [ pattern  { ; pattern }  [ ; ] ]   *)
(* ∣	 pattern ::  pattern   *)
(* ∣	 [| pattern  { ; pattern }  [ ; ] |]   *)
(* ∣	 char-literal ..  char-literal *)
(*	∣	 exception pattern  *)
let rec parse_pattern ?(alias = true) ?(or_ = true) p =
  let start_pos = Parser.start_pos p in
  let attrs = parse_attributes p in
  let pat =
    match Parser.peek p with
    | (True | False) as token ->
      let end_pos = Parser.end_pos p in
      Parser.next p;
      let loc = mk_loc start_pos end_pos in
      Ast_helper.Pat.construct ~loc ~attrs
        (Location.mkloc (Longident.Lident (Token.to_string token)) loc)
        (Location.mkloc [] loc)
    | Int _ | String _ | Float _ | Codepoint _ | Minus | Plus -> (
      let c = parse_constant p in
      match Parser.peek p with
      | DotDot ->
        Parser.next p;
        let c2 = parse_constant p in
        Ast_helper.Pat.interval
          ~loc:(mk_loc start_pos (Parser.position p))
          ~attrs c c2
      | _ ->
        Ast_helper.Pat.constant
          ~loc:(mk_loc start_pos (Parser.position p))
          ~attrs c)
    | Backtick ->
      let constant = parse_template_constant ~start_pos ~prefix:None p in
      Ast_helper.Pat.constant
        ~loc:(mk_loc start_pos (Parser.position p))
        ~attrs constant
    | Lparen -> (
      Parser.next p;
      match Parser.peek p with
      | Rparen ->
        Parser.next p;
        let loc = mk_loc start_pos (Parser.position p) in
        let lid = Location.mkloc (Longident.Lident "()") loc in
        Ast_helper.Pat.construct ~loc ~attrs lid (Location.mkloc [] loc)
      | _ -> (
        let pat = parse_constrained_pattern p in
        match Parser.peek p with
        | Comma ->
          Parser.next p;
          parse_tuple_pattern ~attrs ~first:pat ~start_pos p
        | _ ->
          Parser.expect Rparen p;
          let loc = mk_loc start_pos (Parser.position p) in
          {
            pat with
            ppat_loc = loc;
            ppat_attributes = attrs @ pat.Parsetree.ppat_attributes;
          }))
    | Lbracket -> parse_array_pattern ~attrs p
    | Lbrace -> parse_record_pattern ~attrs p
    | Underscore ->
      let end_pos = Parser.end_pos p in
      let loc = mk_loc start_pos end_pos in
      Parser.next p;
      Ast_helper.Pat.any ~loc ~attrs ()
    | Lident ident -> (
      let end_pos = Parser.end_pos p in
      let loc = mk_loc start_pos end_pos in
      Parser.next p;
      match Parser.peek p with
      | Backtick ->
        let constant =
          parse_template_constant ~start_pos ~prefix:(Some ident) p
        in
        Ast_helper.Pat.constant
          ~loc:(mk_loc start_pos (Parser.position p))
          constant
      | _ -> Ast_helper.Pat.var ~loc ~attrs (Location.mkloc ident loc))
    | Uident _ -> (
      let constr = parse_module_long_ident ~lowercase:false p in
      match Parser.peek p with
      | Lparen -> parse_constructor_pattern_args p constr start_pos attrs
      | _ ->
        Ast_helper.Pat.construct ~loc:constr.loc ~attrs constr
          (Location.mkloc [] constr.loc))
    | DotDotDot ->
      Parser.next p;
      let ident = parse_value_path p in
      let loc = mk_loc start_pos ident.loc.loc_end in
      Ast_helper.Pat.variant_spread ~loc ~attrs ident
    | Hash -> (
      Parser.next p;
      if Parser.peek p == DotDotDot then (
        Parser.next p;
        let ident = parse_value_path p in
        let loc = mk_loc start_pos ident.loc.loc_end in
        Ast_helper.Pat.type_ ~loc ~attrs ident)
      else
        let ident, loc =
          match Parser.peek p with
          | String text ->
            Parser.next p;
            (text, mk_loc start_pos (Parser.position p))
          | Int {i; suffix} ->
            let () =
              match suffix with
              | Some _ ->
                Parser.err p
                  (Diagnostics.message
                     (Error_messages.poly_var_int_with_suffix i))
              | None -> ()
            in
            Parser.next p;
            (i, mk_loc start_pos (Parser.position p))
          | Eof ->
            Parser.err ~start_pos p
              (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs);
            ("", mk_loc start_pos (Parser.position p))
          | _ -> parse_ident ~msg:Error_messages.variant_ident ~start_pos p
        in
        match Parser.peek p with
        | Lparen -> parse_variant_pattern_args p ident start_pos attrs
        | _ -> Ast_helper.Pat.variant ~loc ~attrs ident (Location.mkloc [] loc))
    | Exception ->
      Parser.next p;
      let pat = parse_pattern ~alias:false ~or_:false p in
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Pat.exception_ ~loc ~attrs pat
    | List ->
      Parser.next p;
      parse_list_pattern ~start_pos ~attrs p
    | Dict ->
      Parser.next p;
      parse_dict_pattern ~start_pos ~attrs p
    | Module -> parse_module_pattern ~attrs p
    | Percent ->
      let extension = parse_extension p in
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Pat.extension ~loc ~attrs extension
    | Eof ->
      Parser.err p (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs);
      Recover.default_pattern ()
    | token -> (
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      match
        skip_tokens_and_maybe_retry p
          ~is_start_of_grammar:Grammar.is_atomic_pattern_start
      with
      | None -> Recover.default_pattern ()
      | Some () -> parse_pattern p)
  in
  let pat = if alias then parse_alias_pattern ~attrs pat p else pat in
  if or_ then parse_or_pattern pat p else pat

and skip_tokens_and_maybe_retry p ~is_start_of_grammar =
  if
    Token.is_keyword (Parser.peek p)
    && (Parser.position p).pos_lnum == (Parser.start_pos p).pos_lnum
  then (
    Parser.next p;
    None)
  else if Parser.peek p = Comma then
    (* Something is missing before a comma, e.g. the value in [{a: , b: 1}]:
       leave the comma to the enclosing list instead of skipping to the next
       row *)
    None
  else if Recover.should_abort_list_parse p (Parser.peek p) then
    if is_start_of_grammar (Parser.peek p) then (
      Parser.next p;
      Some ())
    else None
  else (
    Parser.next p;
    let rec loop p =
      if not (Recover.should_abort_list_parse p (Parser.peek p)) then (
        Parser.next p;
        loop p)
    in
    loop p;
    if is_start_of_grammar (Parser.peek p) then Some () else None)

(* alias ::= pattern as lident *)
(* [attrs] were written before [pattern]: with [as], they belong to the alias
   instead, and [pattern] keeps only its own, e.g. [@b] in [@a (@b x) as z] *)
and parse_alias_pattern ~attrs pattern p =
  match Parser.peek p with
  | As ->
    Parser.next p;
    let name, loc = parse_lident p in
    let name = Location.mkloc name loc in
    Ast_helper.Pat.alias
      ~loc:{pattern.ppat_loc with loc_end = Parser.position p}
      ~attrs
      {
        pattern with
        ppat_attributes =
          List.filter
            (fun attr -> not (List.memq attr attrs))
            pattern.ppat_attributes;
      }
      name
  | _ -> pattern

(* or ::= pattern | pattern
 * precedence: Red | Blue | Green is interpreted as (Red | Blue) | Green *)
and parse_or_pattern pattern1 p =
  let rec loop pattern1 =
    match Parser.peek p with
    | Bar ->
      Parser.next p;
      let pattern2 = parse_pattern ~or_:false p in
      let loc =
        {pattern1.Parsetree.ppat_loc with loc_end = pattern2.ppat_loc.loc_end}
      in
      loop (Ast_helper.Pat.or_ ~loc pattern1 pattern2)
    | _ -> pattern1
  in
  loop pattern1

and parse_non_spread_pattern ~msg p =
  let () =
    match Parser.peek p with
    | DotDotDot ->
      Parser.err p (Diagnostics.message msg);
      Parser.next p
    | _ -> ()
  in
  match Parser.peek p with
  | token when Grammar.is_pattern_start token -> (
    let pat = parse_pattern p in
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      let typ = parse_typ_expr p in
      let loc = mk_loc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in
      Some (Ast_helper.Pat.constraint_ ~loc pat typ)
    | _ -> Some pat)
  | _ -> None

and parse_constrained_pattern p =
  let pat = parse_pattern p in
  match Parser.peek p with
  | Colon ->
    Parser.next p;
    let typ = parse_typ_expr p in
    let loc = mk_loc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in
    Ast_helper.Pat.constraint_ ~loc pat typ
  | _ -> pat

and parse_constrained_pattern_region p =
  match Parser.peek p with
  | token when Grammar.is_pattern_start token ->
    Some (parse_constrained_pattern p)
  | _ -> None

and parse_optional_label p =
  match Parser.peek p with
  | Question ->
    Parser.next p;
    true
  | _ -> false

(* field ::=
 *   | longident
 *   | longident : pattern
 *   | longident as lident
 *
 *  row ::=
 *	 | field ,
 *	 | field , _
 *	 | field , _,
 *)
and parse_record_pattern_row_field ~attrs p =
  let label = parse_value_path p in
  let pattern, optional =
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      let optional = parse_optional_label p in
      let pat = parse_pattern p in
      (pat, optional)
    | Equal ->
      Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message Error_messages.record_pattern_field_missing_colon);
      Parser.next p;
      let optional = parse_optional_label p in
      let pat = parse_pattern p in
      (pat, optional)
    | _ ->
      ( Ast_helper.Pat.var ~loc:label.loc ~attrs
          (Location.mkloc (Longident.last label.txt) label.loc),
        false )
  in
  {Parsetree.lid = label; x = pattern; opt = optional}

(* TODO: there are better representations than PatField|Underscore ? *)
and parse_record_pattern_row p =
  let attrs = parse_attributes p in
  match Parser.peek p with
  | DotDotDot -> (
    let rest_start_pos = Parser.start_pos p in
    Parser.next p;
    let start_pos = rest_start_pos in
    let rest_name_start_pos = Parser.start_pos p in
    let has_type_annotation =
      Parser.lookahead p (fun p ->
          ignore (parse_atomic_typ_expr ~attrs:[] p);
          Parser.peek p = As)
    in
    if has_type_annotation then (
      (* ...TypeAnnotation<'a> as name *)
      let core_type = parse_atomic_typ_expr ~attrs:[] p in
      Parser.expect As p;
      let name_start = Parser.start_pos p in
      let name =
        match Parser.peek p with
        | Lident ident ->
          Parser.next p;
          Location.mkloc ident (mk_loc name_start (Parser.position p))
        | _ ->
          Parser.err p (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs);
          Location.mkloc "_" (mk_loc name_start (Parser.position p))
      in
      let rest_loc = mk_loc start_pos (Parser.position p) in
      Some
        ( false,
          PatRest
            {Parsetree.rest_loc; rest_name = name; rest_type = Some core_type}
        ))
    else
      match Parser.peek p with
      | Lident ident ->
        (* ...name (no type annotation) *)
        Parser.next p;
        let loc = mk_loc start_pos (Parser.position p) in
        Some
          ( false,
            PatRest
              {
                Parsetree.rest_loc = loc;
                rest_name =
                  Location.mkloc ident
                    (mk_loc rest_name_start_pos (Parser.position p));
                rest_type = None;
              } )
      | _ ->
        (* Fallback: treat as old-style spread (error) *)
        Some (true, PatField (parse_record_pattern_row_field ~attrs p)))
  | Uident _ | Lident _ ->
    Some (false, PatField (parse_record_pattern_row_field ~attrs p))
  | Question -> (
    Parser.next p;
    match Parser.peek p with
    | Uident _ | Lident _ ->
      let {Parsetree.lid; x = pat} = parse_record_pattern_row_field ~attrs p in
      Some (false, PatField {lid; x = pat; opt = true})
    | _ -> None)
  | Underscore ->
    Parser.next p;
    Some (false, PatUnderscore)
  | _ ->
    if Token.is_keyword (Parser.peek p) then (
      match
        recover_keyword_field_name_if_probably_field p
          ~mk_message:Error_messages.keyword_field_in_pattern
      with
      | Some (recovered_field_name, loc) ->
        Parser.expect Colon p;
        let optional = parse_optional_label p in
        let pat = parse_pattern p in
        let field =
          Location.mkloc (Longident.Lident recovered_field_name) loc
        in
        Some (false, PatField {lid = field; x = pat; opt = optional})
      | None ->
        emit_keyword_field_error p
          ~mk_message:Error_messages.keyword_field_in_pattern;
        None)
    else None

and parse_record_pattern ~attrs p =
  let start_pos = Parser.start_pos p in
  Parser.expect Lbrace p;
  let raw_fields =
    parse_comma_delimited_reversed_list p ~grammar:PatternRecord ~closing:Rbrace
      ~f:parse_record_pattern_row
  in
  Parser.expect Rbrace p;
  let fields, closed_flag, rest =
    let raw_fields, flag =
      match raw_fields with
      | (_hasSpread, PatUnderscore) :: rest -> (rest, Asttypes.Open)
      | raw_fields -> (raw_fields, Asttypes.Closed)
    in
    List.fold_left
      (fun (fields, flag, rest) curr ->
        let has_spread, field = curr in
        match field with
        | PatField field ->
          (if has_spread then
             let pattern = field.x in
             Parser.err ~start_pos:pattern.Parsetree.ppat_loc.loc_start p
               (Diagnostics.message Error_messages.record_pattern_spread));
          (field :: fields, flag, rest)
        | PatRest rest_pat -> (
          match rest with
          | None -> (fields, flag, Some rest_pat)
          | Some _ ->
            Parser.err ~start_pos:rest_pat.Parsetree.rest_loc.loc_start p
              (Diagnostics.message Error_messages.record_pattern_multiple_rest);
            (fields, flag, rest))
        | PatUnderscore -> (fields, flag, rest))
      ([], flag, None) raw_fields
  in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Pat.record ~loc ~attrs ?rest fields closed_flag

and parse_tuple_pattern ~attrs ~first ~start_pos p =
  let patterns =
    first
    :: parse_comma_delimited_region p ~grammar:Grammar.PatternList
         ~closing:Rparen ~f:parse_constrained_pattern_region
  in
  Parser.expect Rparen p;
  let () =
    match patterns with
    | [_] ->
      Parser.err ~start_pos ~end_pos:(Parser.position p) p
        (Diagnostics.message Error_messages.tuple_single_element)
    | _ -> ()
  in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Pat.tuple ~loc ~attrs patterns

and parse_pattern_region p =
  match Parser.peek p with
  | DotDotDot ->
    Parser.next p;
    Some (true, parse_constrained_pattern p)
  | token when Grammar.is_pattern_start token ->
    Some (false, parse_constrained_pattern p)
  | _ -> None

and parse_module_pattern ~attrs p =
  let start_pos = Parser.start_pos p in
  Parser.expect Module p;
  Parser.expect Lparen p;
  let uident =
    match Parser.peek p with
    | Uident uident ->
      let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      Location.mkloc uident loc
    | _ ->
      (* TODO: error recovery *)
      Location.mknoloc "_"
  in
  match Parser.peek p with
  | Colon ->
    let colon_start = Parser.start_pos p in
    Parser.next p;
    let package_typ_attrs = parse_attributes p in
    let package_type =
      parse_package_type ~start_pos:colon_start ~attrs:package_typ_attrs p
    in
    Parser.expect Rparen p;
    let loc = mk_loc start_pos (Parser.position p) in
    let unpack = Ast_helper.Pat.unpack ~loc:uident.loc uident in
    Ast_helper.Pat.constraint_ ~loc ~attrs unpack package_type
  | _ ->
    Parser.expect Rparen p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Pat.unpack ~loc ~attrs uident

and parse_list_pattern ~start_pos ~attrs p =
  let list_patterns =
    parse_comma_delimited_reversed_list p ~grammar:Grammar.PatternOcamlList
      ~closing:Rbrace ~f:parse_pattern_region
  in
  Parser.expect Rbrace p;
  let loc = mk_loc start_pos (Parser.position p) in
  let filter_spread (has_spread, pattern) =
    if has_spread then (
      Parser.err ~start_pos:pattern.Parsetree.ppat_loc.loc_start p
        (Diagnostics.message Error_messages.list_pattern_spread);
      pattern)
    else pattern
  in
  match list_patterns with
  | [(true, pattern)] ->
    (* [list{...p}] is [p] itself. Like [list{...e}] in expressions, it keeps
       the location of [p], so that the comments around the spread stay
       outside it and are printed with [p]. *)
    {pattern with ppat_attributes = attrs}
  | (true, pattern) :: patterns ->
    let patterns = patterns |> List.map filter_spread |> List.rev in
    let pat = make_list_pattern loc patterns (Some pattern) in
    {pat with ppat_loc = loc; ppat_attributes = attrs}
  | patterns ->
    let patterns = patterns |> List.map filter_spread |> List.rev in
    let pat = make_list_pattern loc patterns None in
    {pat with ppat_loc = loc; ppat_attributes = attrs}

and parse_dict_pattern_row p =
  match Parser.peek p with
  | String s ->
    let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
    Parser.next p;
    Parser.expect Colon p;
    let optional = parse_optional_label p in
    let pat = parse_pattern p in
    Some
      {
        Parsetree.pdp_key = Location.mkloc s loc;
        pdp_pattern = pat;
        pdp_optional = optional;
      }
  | _ -> None

and parse_dict_pattern ~start_pos ~attrs (p : Parser.t) =
  let fields =
    parse_comma_delimited_region p ~grammar:PatternDict ~closing:Rbrace
      ~f:parse_dict_pattern_row
  in
  Parser.expect Rbrace p;
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Pat.dict ~loc ~attrs fields

and parse_array_pattern ~attrs p =
  let start_pos = Parser.start_pos p in
  Parser.expect Lbracket p;
  let patterns =
    parse_comma_delimited_region p ~grammar:Grammar.PatternList
      ~closing:Rbracket
      ~f:(parse_non_spread_pattern ~msg:Error_messages.array_pattern_spread)
  in
  Parser.expect Rbracket p;
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Pat.array ~loc ~attrs patterns

and parse_pattern_args p : Parsetree.pattern list Location.loc =
  let lparen = Parser.start_pos p in
  Parser.expect Lparen p;
  let args =
    parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rparen
      ~f:parse_constrained_pattern_region
  in
  Parser.expect Rparen p;
  let loc = mk_loc lparen (Parser.position p) in
  let args =
    match args with
    | [] ->
      [
        Ast_helper.Pat.construct ~loc
          (Location.mkloc (Longident.Lident "()") loc)
          (Location.mkloc [] loc);
      ]
    | patterns -> patterns
  in
  Location.mkloc args loc

and parse_constructor_pattern_args p constr start_pos attrs =
  let args = parse_pattern_args p in
  Ast_helper.Pat.construct
    ~loc:(mk_loc start_pos args.loc.loc_end)
    ~attrs constr args

and parse_variant_pattern_args p ident start_pos attrs =
  let args = parse_pattern_args p in
  Ast_helper.Pat.variant
    ~loc:(mk_loc start_pos args.loc.loc_end)
    ~attrs ident args

and parse_expr ?(context = OrdinaryExpr) p =
  let expr = parse_operand_expr ~context p in
  let expr = parse_binary_expr ~context ~a:expr p 1 in
  parse_ternary_expr expr p

(* expr ? expr : expr *)
and parse_ternary_expr left_operand p =
  match Parser.peek p with
  | Question ->
    Parser.leave_breadcrumb p Grammar.Ternary;
    Parser.next p;
    let true_branch = parse_expr ~context:TernaryTrueBranchExpr p in
    Parser.expect Colon p;
    let false_branch = parse_expr p in
    Parser.eat_breadcrumb p;
    let loc =
      {
        left_operand.Parsetree.pexp_loc with
        loc_start = left_operand.pexp_loc.loc_start;
        loc_end = false_branch.Parsetree.pexp_loc.loc_end;
      }
    in
    Ast_helper.Exp.ternary ~loc left_operand true_branch false_branch
  | _ -> left_operand

and parse_es6_arrow_expression ?(arrow_attrs = []) ?context ?term_parameters
    ~async p =
  let start_pos = Parser.start_pos p in
  Parser.leave_breadcrumb p Grammar.Es6ArrowExpr;
  (* Parsing function parameters and attributes:
     1. Attributes outside of `(...)` are added to the function, e.g. async.
     2. Attributes inside `(...)` are added to the arguments regardless of whether
     labeled, optional or nolabeled. *)
  let parameters =
    match term_parameters with
    | Some params -> ([], params)
    | None -> parse_parameters p
  in
  let return_type =
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      Some (parse_typ_expr ~es6_arrow:false p)
    | _ -> None
  in
  Parser.expect EqualGreater p;
  let body =
    let expr = parse_expr ?context p in
    match return_type with
    | Some typ ->
      Ast_helper.Exp.constraint_
        ~loc:(mk_loc expr.pexp_loc.loc_start typ.Parsetree.ptyp_loc.loc_end)
        expr typ
    | None -> expr
  in
  Parser.eat_breadcrumb p;
  let end_pos = Parser.position p in
  let type_groups, term_parameters = parameters in
  (* In-parens attributes are already attached to the parameter patterns by
     [parse_parameter]. *)
  let fun_params =
    List.map
      (fun {p_label = lbl; expr = default_expr; pat} ->
        {
          Parsetree.p_attrs = [];
          p_lbl = lbl;
          p_default = default_expr;
          p_pat = pat;
        })
      term_parameters
  in
  (* Attributes written in front of the arrow belong to the function node
     itself, independently of any type parameter groups. *)
  let fun_attrs = arrow_attrs in
  let loc = mk_loc start_pos end_pos in
  let newtypes =
    (* Each type parameter group carries its attributes on its first
       newtype; the printer starts a new group at each attribute-bearing
       newtype, so grouping and attributes round-trip. *)
    List.concat_map
      (fun {attrs; locs} ->
        match locs with
        | [] -> []
        | first :: rest ->
          (first, attrs) :: List.map (fun name -> (name, [])) rest)
      type_groups
  in
  let arrow_expr =
    Ast_helper.Exp.fun_ ~loc ~attrs:fun_attrs ~async ~newtypes fun_params body
  in
  {arrow_expr with pexp_loc = {arrow_expr.pexp_loc with loc_start = start_pos}}

(*
 * dotted_parameter ::=
 *   | . parameter                 (* deprecated uncurried syntax *)
 *
 * parameter ::=
 *   | pattern
 *   | pattern : type
 *   | ~ labelName
 *   | ~ labelName as pattern
 *   | ~ labelName as pattern : type
 *   | ~ labelName = expr
 *   | ~ labelName as pattern = expr
 *   | ~ labelName as pattern : type = expr
 *   | ~ labelName = ?
 *   | ~ labelName as pattern = ?
 *   | ~ labelName as pattern : type = ?
 *
 * labelName ::= lident
 *)
and parse_parameter p =
  if Grammar.is_parameter_start (Parser.peek p) then (
    let start_pos = Parser.start_pos p in
    if Parser.peek p = Token.Dot then (
      let dot_loc = mk_loc start_pos (Parser.end_pos p) in
      Parser.next p;
      warn_uncurried_dot_syntax p ~loc:dot_loc);
    let attrs = parse_attributes p in
    if Parser.peek p = Typ then (
      Parser.next p;
      let lidents = parse_lident_list p in
      Some (TypeParameter {attrs; locs = lidents}))
    else
      let lbl, lbl_loc, pat =
        match Parser.peek p with
        | Tilde -> (
          Parser.next p;
          let lbl_name, lbl_loc = parse_lident p in
          match Parser.peek p with
          | Comma | Equal | Rparen ->
            let loc = mk_loc start_pos (Parser.position p) in
            ( Asttypes.Labelled {txt = lbl_name; loc = lbl_loc},
              lbl_loc,
              Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) )
          | Colon ->
            let lbl_end = Parser.position p in
            Parser.next p;
            let typ = parse_typ_expr p in
            let loc = mk_loc start_pos lbl_end in
            let pat =
              let pat = Ast_helper.Pat.var ~loc (Location.mkloc lbl_name loc) in
              let loc = mk_loc start_pos (Parser.position p) in
              Ast_helper.Pat.constraint_ ~attrs ~loc pat typ
            in
            (Asttypes.Labelled {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat)
          | As ->
            Parser.next p;
            let pat =
              let pat = parse_constrained_pattern p in
              {pat with ppat_attributes = attrs @ pat.ppat_attributes}
            in
            (Asttypes.Labelled {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat)
          | t ->
            Parser.err p (Diagnostics.unexpected t p.breadcrumbs);
            let loc = mk_loc start_pos (Parser.position p) in
            ( Asttypes.Labelled {txt = lbl_name; loc = lbl_loc},
              lbl_loc,
              Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) ))
        | _ ->
          let pattern = parse_constrained_pattern p in
          let attrs = List.concat [pattern.ppat_attributes; attrs] in
          ( Asttypes.Nolabel,
            Location.none,
            {pattern with ppat_attributes = attrs} )
      in
      match Parser.peek p with
      | Equal -> (
        Parser.next p;
        let lbl =
          match lbl with
          | Asttypes.Labelled lbl_name -> Asttypes.Optional lbl_name
          | Asttypes.Nolabel ->
            let lbl_name =
              match pat.ppat_desc with
              | Ppat_var var -> var.txt
              | _ -> ""
            in
            Parser.err ~start_pos ~end_pos:(Parser.position p) p
              (Diagnostics.message
                 (Error_messages.missing_tilde_labeled_parameter lbl_name));
            Asttypes.Optional {txt = lbl_name; loc = lbl_loc}
          | lbl -> lbl
        in
        match Parser.peek p with
        | Question ->
          Parser.next p;
          Some (TermParameter {p_label = lbl; expr = None; pat})
        | _ ->
          let expr = parse_constrained_or_coerced_expr p in
          Some (TermParameter {p_label = lbl; expr = Some expr; pat}))
      | _ -> Some (TermParameter {p_label = lbl; expr = None; pat}))
  else None

and parse_parameter_list p =
  let parameters =
    parse_comma_delimited_region ~grammar:Grammar.ParameterList
      ~f:parse_parameter ~closing:Rparen p
  in
  Parser.expect Rparen p;
  extract_fundef_params ~type_acc:[] ~term_acc:[] parameters

(* parameters ::=
 *   | _
 *   | lident
 *   | ()
 *   | (.)                                   (* deprecated uncurried syntax *)
 *   | ( parameter {, parameter} [,] )
 *)
and parse_parameters p : fundef_type_param list * fundef_term_param list =
  let start_pos = Parser.start_pos p in
  let unit_term_parameter () =
    let loc = mk_loc start_pos (Parser.position p) in
    let unit_pattern =
      Ast_helper.Pat.construct ~loc
        (Location.mkloc (Longident.Lident "()") loc)
        (Location.mkloc [] loc)
    in
    {p_label = Asttypes.Nolabel; expr = None; pat = unit_pattern}
  in
  match Parser.peek p with
  | Lident ident ->
    Parser.next p;
    let loc = mk_loc start_pos (Parser.position p) in
    ( [],
      [
        {
          p_label = Asttypes.Nolabel;
          expr = None;
          pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc);
        };
      ] )
  | Underscore ->
    Parser.next p;
    let loc = mk_loc start_pos (Parser.position p) in
    ( [],
      [
        {
          p_label = Asttypes.Nolabel;
          expr = None;
          pat = Ast_helper.Pat.any ~loc ();
        };
      ] )
  | Lparen ->
    Parser.next p;
    if Parser.peek p = Token.Dot then (
      let dot_loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      warn_uncurried_dot_syntax p ~loc:dot_loc);
    let type_params, term_params = parse_parameter_list p in
    let term_params =
      if term_params <> [] then term_params else [unit_term_parameter ()]
    in
    (type_params, term_params)
  | token ->
    Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
    ([], [])

and parse_coerced_expr ~(expr : Parsetree.expression) p =
  Parser.expect ColonGreaterThan p;
  let typ = parse_typ_expr p in
  let loc = mk_loc expr.pexp_loc.loc_start (Parser.position p) in
  Ast_helper.Exp.coerce ~loc expr typ

and parse_constrained_or_coerced_expr p =
  let expr = parse_expr p in
  match Parser.peek p with
  | ColonGreaterThan -> parse_coerced_expr ~expr p
  | Colon -> (
    Parser.next p;
    match Parser.peek p with
    | _ -> (
      let typ = parse_typ_expr p in
      let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in
      let expr = Ast_helper.Exp.constraint_ ~loc expr typ in
      match Parser.peek p with
      | ColonGreaterThan -> parse_coerced_expr ~expr p
      | _ -> expr))
  | _ -> expr

and parse_constrained_expr_region p =
  match Parser.peek p with
  | token when Grammar.is_expr_start token -> (
    let expr = parse_expr p in
    match Parser.peek p with
    | ColonGreaterThan -> Some (parse_coerced_expr ~expr p)
    | Colon ->
      Parser.next p;
      let typ = parse_typ_expr p in
      let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in
      Some (Ast_helper.Exp.constraint_ ~loc expr typ)
    | _ -> Some expr)
  | _ -> None

and parse_regex ~start_pos p pattern flags =
  Parser.next p;
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Exp.regexp ~loc pattern flags

(* Atomic expressions represent unambiguous expressions.
 * This means that regardless of the context, these expressions
 * are always interpreted correctly. *)
and parse_atomic_expr p =
  Parser.leave_breadcrumb p Grammar.ExprOperand;
  let start_pos = Parser.start_pos p in
  let expr =
    match Parser.peek p with
    | (True | False) as token ->
      Parser.next p;
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Exp.construct ~loc
        (Location.mkloc (Longident.Lident (Token.to_string token)) loc)
        (Location.mkloc [] loc)
    | Int _ | String _ | Float _ | Codepoint _ ->
      let c = parse_constant p in
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Exp.constant ~loc c
    | Backtick ->
      let expr = parse_template_expr p in
      {expr with pexp_loc = mk_loc start_pos (Parser.position p)}
    | Uident _ | Lident _ -> parse_value_or_constructor p
    | Hash -> parse_poly_variant_expr p
    | Lparen -> (
      Parser.next p;
      match Parser.peek p with
      | Rparen ->
        Parser.next p;
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Exp.construct ~loc
          (Location.mkloc (Longident.Lident "()") loc)
          (Location.mkloc [] loc)
      | _t -> (
        let expr = parse_constrained_or_coerced_expr p in
        match Parser.peek p with
        | Comma ->
          Parser.next p;
          parse_tuple_expr ~start_pos ~first:expr p
        | _ ->
          Parser.expect Rparen p;
          expr
        (* {expr with pexp_loc = mk_loc start_pos p.prev_end_pos}
         * What does this location mean here? It means that when there's
         * a parenthesized we keep the location here for whitespace interleaving.
         * Without the closing paren in the location there will always be an extra
         * line. For now we don't include it, because it does weird things
         * with for comments. *)))
    | List ->
      Parser.next p;
      parse_list_expr ~start_pos p
    | Dict ->
      Parser.next p;
      parse_dict_expr ~start_pos p
    | Module ->
      Parser.next p;
      parse_first_class_module_expr ~start_pos p
    | Lbracket -> parse_array_exp p
    | Lbrace -> parse_braced_or_record_expr p
    | LessThan -> parse_jsx p
    | Percent -> (
      let (({Location.txt = name; loc = name_loc}, payload) as extension) =
        parse_extension p
      in
      let loc = mk_loc start_pos (Parser.position p) in
      match (Ast_raw.kind_of_name name, Ast_raw.of_payload payload) with
      | Some kind, Some source -> Ast_helper.Exp.raw ~loc ~name_loc kind source
      | _ -> (
        match
          if name = Ast_todo.name then Ast_todo.of_payload payload else None
        with
        | Some message -> Ast_helper.Exp.todo ~loc ~name_loc message
        | None -> Ast_helper.Exp.extension ~loc extension))
    | Underscore as token ->
      (* This case is for error recovery. Not sure if it's the correct place *)
      Parser.err p (Diagnostics.lident token);
      Parser.next p;
      Recover.default_expr ()
    | Eof ->
      Parser.err ~start_pos:(Parser.position p) p
        (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs);
      Recover.default_expr ()
    | Forwardslash | ForwardslashDot -> (
      Parser.next_regex_token p;
      match Parser.peek p with
      | Regex (pattern, flags) -> parse_regex ~start_pos p pattern flags
      | _ -> assert false (* next_regex_token always returns Regex. *))
    | token -> (
      let err_pos = Parser.position p in
      Parser.err ~start_pos:err_pos p
        (Diagnostics.unexpected token p.breadcrumbs);
      match
        skip_tokens_and_maybe_retry p
          ~is_start_of_grammar:Grammar.is_atomic_expr_start
      with
      | None -> Recover.default_expr ()
      | Some () -> parse_atomic_expr p)
  in
  Parser.eat_breadcrumb p;
  expr

(* module(module-expr)
 * module(module-expr : package-type) *)
and parse_first_class_module_expr ~start_pos p =
  Parser.expect Lparen p;

  let mod_expr = parse_module_expr p in
  let mod_end_loc = Parser.position p in
  match Parser.peek p with
  | Colon ->
    let colon_start = Parser.start_pos p in
    Parser.next p;
    let attrs = parse_attributes p in
    let package_type = parse_package_type ~start_pos:colon_start ~attrs p in
    Parser.expect Rparen p;
    let loc = mk_loc start_pos mod_end_loc in
    let first_class_module = Ast_helper.Exp.pack ~loc mod_expr in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.constraint_ ~loc first_class_module package_type
  | _ ->
    Parser.expect Rparen p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.pack ~loc mod_expr

and parse_bracket_access p expr start_pos =
  Parser.leave_breadcrumb p Grammar.ExprArrayAccess;
  let lbracket = Parser.start_pos p in
  Parser.expect Lbracket p;
  let string_start = Parser.start_pos p in
  match Parser.peek p with
  | String s -> (
    Parser.next p;
    let string_end = Parser.position p in
    Parser.expect Rbracket p;
    Parser.eat_breadcrumb p;
    let rbracket = Parser.position p in
    let e =
      let ident_loc = mk_loc string_start string_end in
      let loc = mk_loc start_pos rbracket in
      Ast_helper.Exp.object_get ~loc expr (Location.mkloc s ident_loc)
    in
    let e = parse_primary_expr ~operand:e p in
    let equal_start = Parser.start_pos p in
    match Parser.peek p with
    | Equal -> (
      Parser.next p;
      let equal_end = Parser.position p in
      let rhs_expr = parse_expr p in
      let loc = mk_loc start_pos rhs_expr.pexp_loc.loc_end in
      match e.Parsetree.pexp_desc with
      | Parsetree.Pexp_object_get (obj, name) ->
        Ast_helper.Exp.object_set ~loc obj name rhs_expr
      | _ ->
        Parser.err ~start_pos:equal_start ~end_pos:equal_end p
          (Diagnostics.message
             "The left-hand side of this assignment is not an object property \
              access.");
        e)
    | _ -> e)
  | _ -> (
    let access_expr = parse_constrained_or_coerced_expr p in
    Parser.expect Rbracket p;
    Parser.eat_breadcrumb p;
    let rbracket = Parser.position p in
    let array_loc = mk_loc lbracket rbracket in
    match Parser.peek p with
    | Equal ->
      Parser.leave_breadcrumb p ExprArrayMutation;
      Parser.next p;
      let rhs_expr = parse_expr p in
      (* FIXME: Do not implicitly rely on specific module name, even primitive one

         This can be abused like
           module Array = MyModule

         Find better mechanism to support it
      *)
      let array_set =
        Location.mkloc (Longident.Ldot (Lident "Array", "set")) array_loc
      in
      let end_pos = Parser.position p in
      let array_set =
        Ast_helper.Exp.apply ~loc:(mk_loc start_pos end_pos)
          (Ast_helper.Exp.ident ~loc:array_loc array_set)
          [(Nolabel, expr); (Nolabel, access_expr); (Nolabel, rhs_expr)]
      in
      Parser.eat_breadcrumb p;
      array_set
    | _ ->
      let end_pos = Parser.position p in
      let e =
        Ast_helper.Exp.apply ~loc:(mk_loc start_pos end_pos)
          (Ast_helper.Exp.ident ~loc:array_loc
             (Location.mkloc (Longident.Ldot (Lident "Array", "get")) array_loc))
          [(Nolabel, expr); (Nolabel, access_expr)]
      in
      parse_primary_expr ~operand:e p)

(* * A primary expression represents
 *  - atomic-expr
 *  - john.age
 *  - array[0]
 *  - applyFunctionTo(arg1, arg2)
 *
 *  The "operand" represents the expression that is operated on
 *)
and parse_primary_expr ~operand ?(no_call = false) p =
  let start_pos = operand.pexp_loc.loc_start in
  let rec loop p expr =
    match Parser.peek p with
    | Dot -> (
      Parser.next p;
      let lident = parse_value_path_after_dot p in
      match Parser.peek p with
      | Equal when no_call = false ->
        Parser.leave_breadcrumb p Grammar.ExprSetField;
        Parser.next p;
        let target_expr = parse_expr p in
        let loc = mk_loc start_pos (Parser.position p) in
        let setfield = Ast_helper.Exp.setfield ~loc expr lident target_expr in
        Parser.eat_breadcrumb p;
        setfield
      | _ ->
        let end_pos = Parser.position p in
        let loc = mk_loc start_pos end_pos in
        loop p (Ast_helper.Exp.field ~loc expr lident))
    | Lbracket
      when no_call = false
           && (Parser.position p).pos_lnum == (Parser.start_pos p).pos_lnum ->
      parse_bracket_access p expr start_pos
    | Lparen
      when no_call = false
           && (Parser.position p).pos_lnum == (Parser.start_pos p).pos_lnum ->
      loop p (parse_call_expr p expr)
    | Backtick
      when no_call = false
           && (Parser.position p).pos_lnum == (Parser.start_pos p).pos_lnum -> (
      match expr.pexp_desc with
      | Pexp_ident long_ident -> parse_template_expr ~prefix:long_ident p
      | _ ->
        Parser.err ~start_pos:expr.pexp_loc.loc_start
          ~end_pos:expr.pexp_loc.loc_end p
          (Diagnostics.message
             "Tagged template literals are currently restricted to names like: \
              myTagFunction`foo ${bar}`.");
        parse_template_expr p)
    | _ -> expr
  in
  loop p operand

(* a unary expression is an expression with only one operand and
 * unary operator. Examples:
 *   -1
 *   !condition
 *   -. 1.6
 *)
and parse_unary_expr p =
  let start_pos = Parser.start_pos p in
  match Parser.peek p with
  | (Minus | MinusDot | Plus | PlusDot | Bang | Bnot) as token ->
    Parser.leave_breadcrumb p Grammar.ExprUnary;
    let token_end = Parser.end_pos p in
    Parser.next p;
    let operand = parse_unary_expr p in
    let unary_expr = make_unary_expr start_pos token_end token operand in
    Parser.eat_breadcrumb p;
    unary_expr
  | _ -> parse_primary_expr ~operand:(parse_atomic_expr p) p

(* Represents an "operand" in a binary expression.
 * If you have `a + b`, `a` and `b` both represent
 * the operands of the binary expression with opeartor `+` *)
and parse_operand_expr ~context p =
  let start_pos = Parser.start_pos p in
  let attrs = ref (parse_attributes p) in
  let expr =
    match Parser.peek p with
    | Assert ->
      Parser.next p;
      let expr = parse_expr p in
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Exp.assert_ ~loc expr
    | Lident "async"
    (* we need to be careful when we're in a ternary true branch:
       `condition ? ternary-true-branch : false-branch`
       Arrow expressions could be of the form: `async (): int => stuff()`
       But if we're in a ternary, the `:` of the ternary takes precedence.
       In a guard, `async(x) =>` is a call followed by the case's `=>`.
    *)
      when context != GuardExpr
           && is_es6_arrow_expression
                ~in_ternary:(context = TernaryTrueBranchExpr)
                p ->
      let arrow_attrs = !attrs in
      let () = attrs := [] in
      parse_async_arrow_expression ~arrow_attrs p
    | Await -> parse_await_expression p
    | Try -> parse_try_expression p
    | If -> parse_if_or_if_let_expression p
    | For -> parse_for_expression p
    | While -> parse_while_expression p
    | Switch -> parse_switch_expression p
    | _ ->
      if
        context != WhenExpr && context != GuardExpr
        && is_es6_arrow_expression
             ~in_ternary:(context = TernaryTrueBranchExpr)
             p
      then
        let arrow_attrs = !attrs in
        let () = attrs := [] in
        parse_es6_arrow_expression ~async:false ~arrow_attrs ~context p
      else parse_unary_expr p
  in
  {
    expr with
    pexp_attributes = List.concat [expr.Parsetree.pexp_attributes; !attrs];
  }

(* a binary expression is an expression that combines two expressions with an
 * operator. Examples:
 *    a + b
 *    f(x) |> g(y)
 *)
and parse_binary_expr ?(context = OrdinaryExpr) ?a p prec =
  let a =
    match a with
    | Some e -> e
    | None -> parse_operand_expr ~context p
  in
  let rec loop a =
    let token = Parser.peek_binary_operator p in
    let token_prec =
      match token with
      (* Can the minus be interpreted as a binary operator? Or is it a unary?
       * let w = {
       *   x
       *   -10
       * }
       * vs
       * let w = {
       *   width
       *   - gap
       * }
       *
       * First case is unary, second is a binary operator.
       * See Scanner.isBinaryOp *)
      | (Minus | MinusDot | LessThan | Percent)
        when (not
                (Scanner.is_binary_op p.source (Parser.start_pos p).pos_cnum
                   (Parser.end_pos p).pos_cnum))
             && (Parser.start_pos p).pos_lnum > (Parser.position p).pos_lnum ->
        -1
      | token -> Token.precedence token
    in
    if token_prec < prec then a
    else (
      Parser.leave_breadcrumb p (Grammar.ExprBinaryAfterOp token);
      let start_pos = Parser.start_pos p in
      Parser.next p;
      let end_pos = Parser.position p in
      let token_prec =
        (* exponentiation operator is right-associative *)
        if token = Exponentiation then token_prec else token_prec + 1
      in
      let b = parse_binary_expr ~context p token_prec in
      let loc = mk_loc a.Parsetree.pexp_loc.loc_start b.pexp_loc.loc_end in
      let expr =
        Ast_helper.Exp.apply ~loc
          (make_infix_operator p token start_pos end_pos)
          [(Nolabel, a); (Nolabel, b)]
      in
      Parser.eat_breadcrumb p;
      loop expr)
  in
  loop a

and parse_template_expr ?prefix p =
  let template_start = Parser.start_pos p in
  let parse_parts p =
    let rec aux acc =
      Parser.next_template_literal_token p;
      (* A segment is its text: it starts after the backquote or [}] before
         it and ends before the [${] or backquote after it. *)
      let start_pos = Parser.start_pos p in
      match Parser.peek p with
      | TemplateTail (txt, last_pos) ->
        Parser.next p;
        let loc = mk_loc start_pos last_pos in
        List.rev ((txt, loc, None) :: acc)
      | TemplatePart (txt, last_pos) ->
        Parser.next p;
        let loc = mk_loc start_pos last_pos in
        let expr = parse_expr_block p in
        aux ((txt, loc, Some expr) :: acc)
      | token ->
        Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
        []
    in
    aux []
  in
  let parts = parse_parts p in
  let sources = List.map (fun (txt, loc, _) -> {Location.txt; loc}) parts in
  let values = Ext_list.filter_map parts (fun (_, _, value) -> value) in
  let template_loc = mk_loc template_start (Parser.position p) in
  let gen_tagged_template (lident_loc : Longident.t Location.loc) =
    let ident = Ast_helper.Exp.ident ~attrs:[] ~loc:lident_loc.loc lident_loc in
    let loc = mk_loc lident_loc.loc.loc_start (Parser.position p) in
    Ast_helper.Exp.tagged_template ~loc ident sources values
  in

  match prefix with
  | None ->
    List.iter
      (fun ({Location.txt = source; loc} : string Location.loc) ->
        if String_literal.decode_js_template_escapes source = None then
          Parser.err ~start_pos:loc.loc_start ~end_pos:loc.loc_end p
            (Diagnostics.message
               (if String_literal.is_valid_utf8 source then
                  "Invalid string escape sequence"
                else "Invalid code point")))
      sources;
    Ast_helper.Exp.template ~loc:template_loc sources values
  | Some lident_loc -> gen_tagged_template lident_loc

(* Overparse: let f = a : int => a + 1, is it (a : int) => or (a): int =>
 * Also overparse constraints:
 *  let x = {
 *    let a = 1
 *    a + pi: int
 *  }
 *
 *  We want to give a nice error message in these cases
 *)
and over_parse_constrained_or_coerced_or_arrow_expression p expr =
  match Parser.peek p with
  | ColonGreaterThan -> parse_coerced_expr ~expr p
  | Colon -> (
    Parser.next p;
    let typ = parse_typ_expr ~es6_arrow:false p in
    match Parser.peek p with
    | EqualGreater ->
      Parser.next p;
      let body = parse_expr p in
      let pat, expr_is_unit =
        match expr.pexp_desc with
        | Pexp_ident longident ->
          ( Ast_helper.Pat.var ~loc:expr.pexp_loc
              (Location.mkloc
                 (Longident.flatten longident.txt |> String.concat ".")
                 longident.loc),
            false )
        | Pexp_construct (({txt = Longident.Lident "()"} as lid), {txt = []}) ->
          ( Ast_helper.Pat.construct ~loc:expr.pexp_loc lid
              (Location.mkloc [] expr.pexp_loc),
            true )
        (* TODO: can we convert more expressions to patterns?*)
        | _ ->
          ( Ast_helper.Pat.var ~loc:expr.pexp_loc
              (Location.mkloc "pattern" expr.pexp_loc),
            false )
      in
      let arrow1 =
        Ast_helper.Exp.fun_
          ~loc:(mk_loc expr.pexp_loc.loc_start body.pexp_loc.loc_end)
          [Ast_helper.Exp.fun_param Asttypes.Nolabel pat]
          (Ast_helper.Exp.constraint_ body typ)
      in
      (* When the "expr" was `()`, the colon must apply to the return type, so
         skip the ambiguity diagnostic and keep the parameter as unit. *)
      if expr_is_unit then arrow1
      else
        let arrow2 =
          Ast_helper.Exp.fun_
            ~loc:(mk_loc expr.pexp_loc.loc_start body.pexp_loc.loc_end)
            [
              Ast_helper.Exp.fun_param Asttypes.Nolabel
                (Ast_helper.Pat.constraint_ pat typ);
            ]
            body
        in
        let msg =
          Doc.breakable_group ~force_break:true
            (Doc.concat
               [
                 Doc.text
                   "Did you mean to annotate the parameter type or the return \
                    type?";
                 Doc.indent
                   (Doc.concat
                      [
                        Doc.line;
                        Doc.text "1) ";
                        Res_printer.print_expression arrow1 Comment_table.empty;
                        Doc.line;
                        Doc.text "2) ";
                        Res_printer.print_expression arrow2 Comment_table.empty;
                      ]);
               ])
          |> Doc.to_string ~width:80
        in
        Parser.err ~start_pos:expr.pexp_loc.loc_start
          ~end_pos:body.pexp_loc.loc_end p (Diagnostics.message msg);
        arrow1
    | _ ->
      let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in
      let expr = Ast_helper.Exp.constraint_ ~loc expr typ in
      let () =
        Parser.err ~start_pos:expr.pexp_loc.loc_start
          ~end_pos:typ.ptyp_loc.loc_end p
          (Diagnostics.message
             (Doc.breakable_group ~force_break:true
                (Doc.concat
                   [
                     Doc.text
                       "Expressions with type constraints need to be wrapped \
                        in parens:";
                     Doc.indent
                       (Doc.concat
                          [
                            Doc.line;
                            Res_printer.add_parens
                              (Res_printer.print_expression expr
                                 Comment_table.empty);
                          ]);
                   ])
             |> Doc.to_string ~width:80))
      in
      expr)
  | _ -> expr

and parse_let_binding_body ~start_pos ~attrs p =
  Parser.begin_region p;
  Parser.leave_breadcrumb p Grammar.LetBinding;
  let pat, exp, constraint_ =
    Parser.leave_breadcrumb p Grammar.Pattern;
    let pat = parse_pattern p in
    Parser.eat_breadcrumb p;
    match Parser.peek p with
    | Colon -> (
      Parser.next p;
      match Parser.peek p with
      | Typ ->
        (* locally abstract types *)
        Parser.next p;
        let newtypes = parse_lident_list p in
        Parser.expect Dot p;
        let typ = parse_typ_expr p in
        Parser.expect Equal p;
        let expr = parse_expr p in
        (pat, expr, Some {Parsetree.pvc_newtypes = newtypes; pvc_type = typ})
      | _ ->
        let poly_type = parse_poly_type_expr p in
        let loc =
          {pat.ppat_loc with loc_end = poly_type.Parsetree.ptyp_loc.loc_end}
        in
        let pat = Ast_helper.Pat.constraint_ ~loc pat poly_type in
        Parser.expect Token.Equal p;
        let exp = parse_expr p in
        let exp = over_parse_constrained_or_coerced_or_arrow_expression p exp in
        (pat, exp, None))
    | _ ->
      Parser.expect Token.Equal p;
      let exp =
        over_parse_constrained_or_coerced_or_arrow_expression p (parse_expr p)
      in
      (pat, exp, None)
  in
  let loc = mk_loc start_pos (Parser.position p) in
  let vb = Ast_helper.Vb.mk ~loc ~attrs ?constraint_ pat exp in
  Parser.eat_breadcrumb p;
  Parser.end_region p;
  vb

(* Attributes belong to this binding only when followed by [and]. *)
and parse_attributes_and_binding (p : Parser.t) =
  match Parser.peek p with
  | At | DocComment _ -> (
    match
      Parser.try_parse p (fun p ->
          let attrs = parse_attributes p in
          if Parser.peek p = And then Some attrs else None)
    with
    | Some attrs -> attrs
    | None -> [])
  | _ -> []

(* definition	::=	let [rec] let-binding  { and let-binding }   *)
and parse_let_bindings ~unwrap ~attrs ~start_pos p =
  Parser.optional p (Let {unwrap}) |> ignore;
  let rec_flag =
    if Parser.optional p Token.Rec then Asttypes.Recursive
    else Asttypes.Nonrecursive
  in
  let end_pos = Parser.start_pos p in
  if rec_flag = Asttypes.Recursive && unwrap then
    Parser.err ~start_pos ~end_pos p
      (Diagnostics.message Error_messages.experimental_let_unwrap_rec);
  let add_unwrap_attr ~unwrap ~start_pos ~end_pos attrs =
    if unwrap then
      ( {Asttypes.txt = "let.unwrap"; loc = mk_loc start_pos end_pos},
        Ast_payload.empty )
      :: attrs
    else attrs
  in
  let attrs = add_unwrap_attr ~unwrap ~start_pos ~end_pos attrs in
  let first = parse_let_binding_body ~start_pos ~attrs p in

  let rec loop p bindings =
    let start_pos = Parser.start_pos p in
    let end_pos = Parser.end_pos p in
    let attrs = parse_attributes_and_binding p in
    let attrs = add_unwrap_attr ~unwrap ~start_pos ~end_pos attrs in
    match Parser.peek p with
    | And ->
      Parser.next p;
      ignore (Parser.optional p (Let {unwrap = false}));
      (* overparse for fault tolerance *)
      let let_binding = parse_let_binding_body ~start_pos ~attrs p in
      loop p (let_binding :: bindings)
    | _ -> List.rev bindings
  in
  (rec_flag, loop p [first])

and parse_jsx_name p : Parsetree.jsx_tag_name Location.loc =
  match read_jsx_tag_name p with
  | Ok name -> name
  | Error invalid_str ->
    let msg =
      "A jsx name must be a lowercase or uppercase name, like: div in <div /> \
       or Navbar in <Navbar />"
    in
    Parser.err p (Diagnostics.message msg);
    {txt = Parsetree.JsxTagInvalid invalid_str; loc = Location.none}

and parse_jsx_opening_or_self_closing_element (* start of the opening < *)
    ~start_pos p : Parsetree.expression =
  let name = parse_jsx_name p in
  let jsx_props = parse_jsx_props p in
  match Parser.peek p with
  | Forwardslash ->
    (* <foo a=b /> *)
    Parser.next p;
    let jsx_end_pos = Parser.end_pos p in
    Parser.expect GreaterThan p;
    let loc = mk_loc start_pos jsx_end_pos in
    Ast_helper.Exp.jsx_unary_element ~loc name jsx_props
  | GreaterThan -> (
    (* <foo a=b> bar </foo> *)
    let opening_tag_end = Parser.start_pos p in
    Parser.next p;
    let children = parse_jsx_children p in
    let closing_tag_start =
      match Parser.peek p with
      | LessThan when Parser.peek_slash p ->
        let pos = Parser.start_pos p in
        (* Move to slash *)
        Parser.next p;
        (* Move to ident *)
        Parser.next p;
        Some pos
      | token when Grammar.is_structure_item_start token -> None
      | _ ->
        Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
          (Diagnostics.message "Did you forget a `</` here?");
        None
    in
    (* Read the closing tag name and verify it matches the opening name *)
    let token0 = Parser.peek p in
    match token0 with
    | Lident _ | Uident _ -> (
      (* Consume the closing name without mutating tokens beforehand *)
      let closing_name_res = read_jsx_tag_name p in
      match closing_name_res with
      | Ok closing_name
        when Ast_helper.Jsx.longident_of_jsx_tag_name closing_name.txt
             = Ast_helper.Jsx.longident_of_jsx_tag_name name.txt ->
        let end_tag_name = closing_name in
        let closing_tag_end = Parser.start_pos p in
        Parser.expect GreaterThan p;
        let loc = mk_loc start_pos (Parser.position p) in
        let closing_tag =
          closing_tag_start
          |> Option.map (fun closing_tag_start ->
              {
                Parsetree.jsx_closing_container_tag_start = closing_tag_start;
                jsx_closing_container_tag_name = end_tag_name;
                jsx_closing_container_tag_end = closing_tag_end;
              })
        in
        Ast_helper.Exp.jsx_container_element ~loc name jsx_props opening_tag_end
          children closing_tag
      | _ ->
        let () =
          if Grammar.is_structure_item_start token0 then (
            let closing =
              "</" ^ Ast_helper.Jsx.string_of_jsx_tag_name name.txt ^ ">"
            in
            let msg = Diagnostics.message ("Missing " ^ closing) in
            Parser.err ~start_pos ~end_pos:(Parser.position p) p msg;
            (* We attempted to read a closing name; consume the '>' to keep AST shape stable *)
            Parser.expect GreaterThan p)
          else
            let opening =
              "</" ^ Ast_helper.Jsx.string_of_jsx_tag_name name.txt ^ ">"
            in
            let msg =
              "Closing jsx name should be the same as the opening name. Did \
               you mean " ^ opening ^ " ?"
            in
            Parser.err ~start_pos ~end_pos:(Parser.position p) p
              (Diagnostics.message msg);
            (* read_jsx_tag_name already consumed the name; expect the '>') *)
            Parser.expect GreaterThan p
        in
        let end_tag_name =
          match closing_name_res with
          | Ok closing_name -> closing_name
          | Error invalid_str ->
            {txt = Parsetree.JsxTagInvalid invalid_str; loc = Location.none}
        in
        let closing_tag_end = Parser.position p in
        let closing_tag =
          closing_tag_start
          |> Option.map (fun closing_tag_start ->
              {
                Parsetree.jsx_closing_container_tag_start = closing_tag_start;
                jsx_closing_container_tag_name = end_tag_name;
                jsx_closing_container_tag_end = closing_tag_end;
              })
        in
        Ast_helper.Exp.jsx_container_element
          ~loc:(mk_loc start_pos (Parser.position p))
          name jsx_props opening_tag_end children closing_tag)
    | token ->
      let () =
        if Grammar.is_structure_item_start token then
          let closing =
            "</" ^ Ast_helper.Jsx.string_of_jsx_tag_name name.txt ^ ">"
          in
          let msg = Diagnostics.message ("Missing " ^ closing) in
          Parser.err ~start_pos ~end_pos:(Parser.position p) p msg
        else
          let opening =
            "</" ^ Ast_helper.Jsx.string_of_jsx_tag_name name.txt ^ ">"
          in
          let msg =
            "Closing jsx name should be the same as the opening name. Did you \
             mean " ^ opening ^ " ?"
          in
          Parser.err ~start_pos ~end_pos:(Parser.position p) p
            (Diagnostics.message msg)
      in
      Ast_helper.Exp.jsx_container_element
        ~loc:(mk_loc start_pos (Parser.position p))
        name jsx_props opening_tag_end children None)
  | token ->
    Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
    Ast_helper.Exp.jsx_unary_element
      ~loc:(mk_loc start_pos (Parser.position p))
      name jsx_props

(*
 *  jsx ::=
 *    | <> jsx-children </>
 *    | <element-name {jsx-prop} />
 *    | <element-name {jsx-prop}> jsx-children </element-name>
 *
 *  jsx-children ::= primary-expr*          * => 0 or more
 *)
and parse_jsx p =
  Parser.leave_breadcrumb p Grammar.Jsx;
  let start_pos = Parser.start_pos p in
  Parser.expect LessThan p;
  let jsx_expr =
    match Parser.peek p with
    | Lident _ | Uident _ ->
      parse_jsx_opening_or_self_closing_element ~start_pos p
    | GreaterThan ->
      (* fragment: <> foo </> *)
      parse_jsx_fragment start_pos p
    | _ ->
      let tag_name = parse_jsx_name p in
      let (loc : Location.t) = tag_name.loc in
      let lid = Ast_helper.Jsx.longident_of_jsx_tag_name tag_name.txt in
      Ast_helper.Exp.ident ~loc (Location.mkloc lid loc)
  in
  Parser.eat_breadcrumb p;
  jsx_expr

(*
 * jsx-fragment ::=
 *  | <> </>
 *  | <> jsx-children </>
 *)
and parse_jsx_fragment start_pos p =
  let children_start_pos = Parser.start_pos p in
  Parser.expect GreaterThan p;
  let children = parse_jsx_children p in
  let children_end_pos = Parser.start_pos p in
  Parser.expect LessThan p;
  Parser.expect Forwardslash p;
  let end_pos = Parser.end_pos p in
  Parser.expect GreaterThan p;
  (* location is from starting < till closing >  *)
  let loc = mk_loc start_pos end_pos in
  Ast_helper.Exp.jsx_fragment ~attrs:[] ~loc children_start_pos children
    children_end_pos

(*
 * jsx-prop ::=
 *   |  lident
 *   | ?lident
 *   |  lident =  jsx_expr
 *   |  lident = ?jsx_expr
 *   |  {...jsx_expr}
 *)
and parse_jsx_prop p : Parsetree.jsx_prop option =
  match Parser.peek p with
  | Question | Lident _ -> (
    let optional = Parser.optional p Question in
    (* allow hyphens inside prop names by reading a local jsx name *)
    match read_local_jsx_name p with
    | Some (name, loc, `Lower) -> (
      if optional then Some (Parsetree.JSXPropPunning (true, {txt = name; loc}))
      else
        match Parser.peek p with
        | Equal ->
          Parser.next p;
          let optional = Parser.optional p Question in
          let attr_expr =
            match Parser.peek p with
            | Forwardslash as token when Parser.peek2 p = GreaterThan ->
              Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
              Recover.default_expr ()
            | _ -> parse_primary_expr ~operand:(parse_atomic_expr p) p
          in
          Some (Parsetree.JSXPropValue ({txt = name; loc}, optional, attr_expr))
        | _ -> Some (Parsetree.JSXPropPunning (false, {txt = name; loc})))
    | Some (_name, _loc, `Upper) ->
      Parser.err p (Diagnostics.message "JSX prop names must be lowercase");
      None
    | None -> None)
  (* {...props} *)
  | Lbrace -> (
    let spread_start = Parser.start_pos p in
    Parser.next p;
    match Parser.peek p with
    | DotDotDot -> (
      Parser.next p;
      let attr_expr = parse_primary_expr ~operand:(parse_expr p) p in
      match Parser.peek p with
      | Rbrace ->
        let spread_end = Parser.end_pos p in
        let loc = mk_loc spread_start spread_end in
        Parser.next p;
        Some (Parsetree.JSXPropSpreading (loc, attr_expr))
        (* Some (label, attr_expr) *)
      | _ -> None)
    | _ -> None)
  | _ -> None

and parse_jsx_props p : Parsetree.jsx_prop list =
  parse_region ~grammar:Grammar.JsxAttribute ~f:parse_jsx_prop p

and parse_jsx_children p : Parsetree.jsx_children =
  let rec loop p children =
    match Parser.peek p with
    | Token.Eof -> children
    | LessThan when Parser.peek_slash p -> children
    | LessThan ->
      (* Imagine: <div> <Navbar /> <
       * is `<` the start of a jsx-child? <div …
       * or is it the start of a closing tag?  </div>
       * reconsiderLessThan peeks at the next token and
       * determines the correct token to disambiguate *)
      let child =
        parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p
      in
      loop p (child :: children)
    | Lbrace when Parser.peek2 p = Rbrace ->
      let start_pos = Parser.start_pos p in
      Parser.next p;
      (* next commits the consumed token's leading comments. Snapshot after {
         so consuming } prepends exactly the comments inside the braces. *)
      let comments_before = p.comments in
      Parser.next p;
      (* Only comment-containing containers are trivia. Keep bare {} as an
         empty record, including when nested inside an expression container. *)
      if p.comments != comments_before then (
        let loc = mk_loc start_pos (Parser.position p) in
        let rec mark_container comments =
          if comments != comments_before then
            match comments with
            | [] -> ()
            | comment :: rest ->
              Res_comment.set_jsx_container comment loc;
              mark_container rest
        in
        mark_container p.comments;
        loop p children)
      else
        let loc = mk_loc start_pos (Parser.position p) in
        let child =
          parse_primary_expr
            ~operand:(Ast_helper.Exp.record ~loc [] None)
            ~no_call:true p
        in
        loop p (child :: children)
    | token when Grammar.is_jsx_child_start token ->
      let child =
        parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p
      in
      loop p (child :: children)
    | _ -> children
  in
  match Parser.peek p with
  | DotDotDot ->
    Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
      (Diagnostics.message Error_messages.spread_children_no_longer_supported);
    Parser.next p;
    [parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p]
  | _ -> List.rev (loop p [])

and parse_braced_or_record_expr p =
  let start_pos = Parser.start_pos p in
  Parser.expect Lbrace p;
  match Parser.peek p with
  | Break ->
    let expr = parse_expr_block p in
    Parser.expect Rbrace p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.braces ~braces_loc:loc expr
  | Continue ->
    let expr = parse_expr_block p in
    Parser.expect Rbrace p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.braces ~braces_loc:loc expr
  | token when Token.is_keyword token -> (
    match
      recover_keyword_field_name_if_probably_field p
        ~mk_message:Error_messages.keyword_field_in_expr
    with
    | Some (recovered_field_name, loc) ->
      Parser.expect Colon p;
      let optional = parse_optional_label p in
      let field_expr = parse_expr p in
      let field = Location.mkloc (Longident.Lident recovered_field_name) loc in
      let first_row = {Parsetree.lid = field; x = field_expr; opt = optional} in
      let expr = parse_record_expr ~start_pos [first_row] p in
      Parser.expect Rbrace p;
      expr
    | None ->
      let expr = parse_expr_block p in
      Parser.expect Rbrace p;
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Exp.braces ~braces_loc:loc expr)
  | Rbrace ->
    Parser.next p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.record ~loc [] None
  | DotDotDot ->
    (* beginning of record spread, parse record *)
    Parser.next p;
    let spread_expr = parse_constrained_or_coerced_expr p in
    Parser.expect Comma p;
    let expr = parse_record_expr ~start_pos ~spread:(Some spread_expr) [] p in
    Parser.expect Rbrace p;
    expr
  | String s -> (
    let field =
      let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      Location.mkloc (Longident.Lident s) loc
    in
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      let field_expr = parse_expr p in
      Parser.optional p Comma |> ignore;
      let expr =
        parse_record_expr_with_string_keys ~start_pos
          {Parsetree.lid = field; x = field_expr; opt = false}
          p
      in
      Parser.expect Rbrace p;
      expr
    | Equal ->
      Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message Error_messages.record_field_missing_colon);
      Parser.next p;
      let field_expr = parse_expr p in
      Parser.optional p Comma |> ignore;
      let expr =
        parse_record_expr_with_string_keys ~start_pos
          {Parsetree.lid = field; x = field_expr; opt = false}
          p
      in
      Parser.expect Rbrace p;
      expr
    | _ -> (
      let constant =
        Ast_helper.Exp.constant ~loc:field.loc
          (parse_string_constant p ~start_pos:field.loc.loc_start
             ~end_pos:field.loc.loc_end s)
      in
      let a = parse_primary_expr ~operand:constant p in
      let e = parse_binary_expr ~a p 1 in
      let e = parse_ternary_expr e p in
      match Parser.peek p with
      | Semicolon ->
        let expr = parse_expr_block ~first:e p in
        Parser.expect Rbrace p;
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Exp.braces ~braces_loc:loc expr
      | Rbrace ->
        Parser.next p;
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Exp.braces ~braces_loc:loc e
      | _ ->
        let expr = parse_expr_block ~first:e p in
        Parser.expect Rbrace p;
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Exp.braces ~braces_loc:loc expr))
  | Question ->
    let expr = parse_record_expr ~start_pos [] p in
    Parser.expect Rbrace p;
    expr
  (*
    The branch below takes care of the "braced" expression {async}.
    The big reason that we need all these branches is that {x} isn't a record with a punned field x, but a braced expression… There's lots of "ambiguity" between a record with a single punned field and a braced expression…
    What is {x}?
      1) record {x: x}
      2) expression x which happens to wrapped in braces
    Due to historical reasons, we always follow 2
  *)
  | Lident "async" when is_es6_arrow_expression ~in_ternary:false p ->
    let expr = parse_async_arrow_expression p in
    let expr = parse_expr_block ~first:expr p in
    Parser.expect Rbrace p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.braces ~braces_loc:loc expr
  | Uident _ | Lident _ -> (
    let start_token = Parser.peek p in
    let value_or_constructor = parse_value_or_constructor p in
    match value_or_constructor.pexp_desc with
    | Pexp_ident path_ident -> (
      let ident_end_pos = Parser.position p in
      match Parser.peek p with
      | Comma ->
        Parser.next p;
        let value_or_constructor =
          match start_token with
          | Uident _ ->
            remove_module_name_from_punned_field_value value_or_constructor
          | _ -> value_or_constructor
        in
        let expr =
          parse_record_expr ~start_pos
            [
              {Parsetree.lid = path_ident; x = value_or_constructor; opt = false};
            ]
            p
        in
        Parser.expect Rbrace p;
        expr
      | Colon -> (
        Parser.next p;
        let optional = parse_optional_label p in
        let field_expr = parse_expr p in
        match Parser.peek p with
        | Rbrace ->
          Parser.next p;
          let loc = mk_loc start_pos (Parser.position p) in
          Ast_helper.Exp.record ~loc
            [{lid = path_ident; x = field_expr; opt = optional}]
            None
        | _ ->
          Parser.expect Comma p;
          let expr =
            parse_record_expr ~start_pos
              [{lid = path_ident; x = field_expr; opt = optional}]
              p
          in
          Parser.expect Rbrace p;
          expr)
      | Equal -> (
        Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
          (Diagnostics.message Error_messages.record_field_missing_colon);
        Parser.next p;
        let optional = parse_optional_label p in
        let field_expr = parse_expr p in
        match Parser.peek p with
        | Rbrace ->
          Parser.next p;
          let loc = mk_loc start_pos (Parser.position p) in
          Ast_helper.Exp.record ~loc
            [{lid = path_ident; x = field_expr; opt = optional}]
            None
        | _ ->
          Parser.expect Comma p;
          let expr =
            parse_record_expr ~start_pos
              [{lid = path_ident; x = field_expr; opt = optional}]
              p
          in
          Parser.expect Rbrace p;
          expr)
      (* error case *)
      | Lident _ ->
        if (Parser.position p).pos_lnum < (Parser.start_pos p).pos_lnum then (
          Parser.expect Comma p;
          let expr =
            parse_record_expr ~start_pos
              [{lid = path_ident; x = value_or_constructor; opt = false}]
              p
          in
          Parser.expect Rbrace p;
          expr)
        else (
          Parser.expect Colon p;
          let expr =
            parse_record_expr ~start_pos
              [{lid = path_ident; x = value_or_constructor; opt = false}]
              p
          in
          Parser.expect Rbrace p;
          expr)
      | Semicolon ->
        let expr =
          parse_expr_block ~first:(Ast_helper.Exp.ident path_ident) p
        in
        Parser.expect Rbrace p;
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Exp.braces ~braces_loc:loc expr
      | Rbrace ->
        Parser.next p;
        let expr = Ast_helper.Exp.ident ~loc:path_ident.loc path_ident in
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Exp.braces ~braces_loc:loc expr
      | EqualGreater -> (
        let loc = mk_loc start_pos ident_end_pos in
        let ident = Location.mkloc (Longident.last path_ident.txt) loc in
        let a =
          parse_es6_arrow_expression ~async:false
            ~term_parameters:
              [
                {
                  p_label = Nolabel;
                  expr = None;
                  pat = Ast_helper.Pat.var ~loc:ident.loc ident;
                };
              ]
            p
        in
        let e = parse_binary_expr ~a p 1 in
        let e = parse_ternary_expr e p in
        match Parser.peek p with
        | Semicolon ->
          let expr = parse_expr_block ~first:e p in
          Parser.expect Rbrace p;
          let loc = mk_loc start_pos (Parser.position p) in
          Ast_helper.Exp.braces ~braces_loc:loc expr
        | Rbrace ->
          Parser.next p;
          let loc = mk_loc start_pos (Parser.position p) in
          Ast_helper.Exp.braces ~braces_loc:loc e
        | _ ->
          let expr = parse_expr_block ~first:e p in
          Parser.expect Rbrace p;
          let loc = mk_loc start_pos (Parser.position p) in
          Ast_helper.Exp.braces ~braces_loc:loc expr)
      | _ -> (
        Parser.leave_breadcrumb p Grammar.ExprBlock;
        let a =
          parse_primary_expr
            ~operand:(Ast_helper.Exp.ident ~loc:path_ident.loc path_ident)
            p
        in
        let e = parse_binary_expr ~a p 1 in
        let e = parse_ternary_expr e p in
        Parser.eat_breadcrumb p;
        match Parser.peek p with
        | Semicolon ->
          let expr = parse_expr_block ~first:e p in
          Parser.expect Rbrace p;
          let loc = mk_loc start_pos (Parser.position p) in
          Ast_helper.Exp.braces ~braces_loc:loc expr
        | Rbrace ->
          Parser.next p;
          let loc = mk_loc start_pos (Parser.position p) in
          Ast_helper.Exp.braces ~braces_loc:loc e
        | _ ->
          let expr = parse_expr_block ~first:e p in
          Parser.expect Rbrace p;
          let loc = mk_loc start_pos (Parser.position p) in
          Ast_helper.Exp.braces ~braces_loc:loc expr))
    | _ -> (
      Parser.leave_breadcrumb p Grammar.ExprBlock;
      let a = parse_primary_expr ~operand:value_or_constructor p in
      let e = parse_binary_expr ~a p 1 in
      let e = parse_ternary_expr e p in
      Parser.eat_breadcrumb p;
      match Parser.peek p with
      | Semicolon ->
        let expr = parse_expr_block ~first:e p in
        Parser.expect Rbrace p;
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Exp.braces ~braces_loc:loc expr
      | Rbrace ->
        Parser.next p;
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Exp.braces ~braces_loc:loc e
      | _ ->
        let expr = parse_expr_block ~first:e p in
        Parser.expect Rbrace p;
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Exp.braces ~braces_loc:loc expr))
  | _ ->
    let expr = parse_expr_block p in
    Parser.expect Rbrace p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.braces ~braces_loc:loc expr

and parse_record_expr_row_with_string_key p :
    Parsetree.expression Parsetree.record_element option =
  match Parser.peek p with
  | String s -> (
    let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
    Parser.next p;
    let field = Location.mkloc (Longident.Lident s) loc in
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      let field_expr = parse_expr p in
      Some {lid = field; x = field_expr; opt = false}
    | Equal ->
      Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message Error_messages.record_field_missing_colon);
      Parser.next p;
      let field_expr = parse_expr p in
      Some {lid = field; x = field_expr; opt = false}
    | _ ->
      Some
        {
          lid = field;
          x = Ast_helper.Exp.ident ~loc:field.loc field;
          opt = false;
        })
  | _ -> None

and parse_record_expr_row p :
    Parsetree.expression Parsetree.record_element option =
  let attrs = parse_attributes p in
  let () =
    match Parser.peek p with
    | Token.DotDotDot ->
      Parser.err p (Diagnostics.message Error_messages.record_expr_spread);
      Parser.next p
    | _ -> ()
  in
  match Parser.peek p with
  | Lident _ | Uident _ -> (
    let start_token = Parser.peek p in
    let field = parse_value_path p in
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      let optional = parse_optional_label p in
      let field_expr = parse_expr p in
      Some {lid = field; x = field_expr; opt = optional}
    | Equal ->
      Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message Error_messages.record_field_missing_colon);
      Parser.next p;
      let optional = parse_optional_label p in
      let field_expr = parse_expr p in
      Some {lid = field; x = field_expr; opt = optional}
    | _ ->
      let value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in
      let value =
        match start_token with
        | Uident _ -> remove_module_name_from_punned_field_value value
        | _ -> value
      in
      Some {lid = field; x = value; opt = false})
  | Question -> (
    Parser.next p;
    match Parser.peek p with
    | Lident _ | Uident _ ->
      let start_token = Parser.peek p in
      let field = parse_value_path p in
      let value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in
      let value =
        match start_token with
        | Uident _ -> remove_module_name_from_punned_field_value value
        | _ -> value
      in
      Some {lid = field; x = value; opt = true}
    | _ -> None)
  | _ ->
    if Token.is_keyword (Parser.peek p) then (
      match
        recover_keyword_field_name_if_probably_field p
          ~mk_message:Error_messages.keyword_field_in_expr
      with
      | Some (recovered_field_name, loc) ->
        Parser.expect Colon p;
        let optional = parse_optional_label p in
        let field_expr = parse_expr p in
        let field =
          Location.mkloc (Longident.Lident recovered_field_name) loc
        in
        Some {lid = field; x = field_expr; opt = optional}
      | None ->
        emit_keyword_field_error p
          ~mk_message:Error_messages.keyword_field_in_expr;
        None)
    else None

and parse_dict_expr_part p =
  match Parser.peek p with
  | DotDotDot ->
    Parser.next p;
    let spread_expr = parse_constrained_or_coerced_expr p in
    Some (Parsetree.Pdict_spread spread_expr)
  | String s -> (
    let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
    Parser.next p;
    let key = Location.mkloc s loc in
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      let field_expr = parse_expr p in
      Some (Parsetree.Pdict_entry (key, field_expr))
    | Equal ->
      Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message Error_messages.dict_field_missing_colon);
      Parser.next p;
      let field_expr = parse_expr p in
      Some (Pdict_entry (key, field_expr))
    | _ ->
      Some
        (Pdict_entry
           ( key,
             Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident s) loc)
           )))
  | _ -> None

and parse_record_expr_with_string_keys ~start_pos first_row p =
  let rows =
    first_row
    :: parse_comma_delimited_region ~grammar:Grammar.RecordRowsStringKey
         ~closing:Rbrace ~f:parse_record_expr_row_with_string_key p
  in
  let loc = mk_loc start_pos (Parser.end_pos p) in
  let fields =
    Ext_list.map rows (fun {Parsetree.lid; x} ->
        let name =
          match lid.txt with
          | Longident.Lident name -> Location.mkloc name lid.loc
          | _ -> assert false
        in
        (name, x))
  in
  Ast_helper.Exp.object_literal ~loc fields

and parse_record_expr ~start_pos ?(spread = None) rows p =
  let exprs =
    parse_comma_delimited_region ~grammar:Grammar.RecordRows ~closing:Rbrace
      ~f:parse_record_expr_row p
  in
  let rows = rows @ exprs in
  let () =
    match rows with
    | [] ->
      let msg = "Record spread needs at least one field that's updated" in
      Parser.err p (Diagnostics.message msg)
    | _rows -> ()
  in
  let loc = mk_loc start_pos (Parser.end_pos p) in
  Ast_helper.Exp.record ~loc rows spread

and parse_newline_or_semicolon_expr_block p =
  match Parser.peek p with
  | Semicolon -> Parser.next p
  | token when Grammar.is_block_expr_start token ->
    if (Parser.position p).pos_lnum < (Parser.start_pos p).pos_lnum then ()
    else
      Parser.err ~start_pos:(Parser.position p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message
           "consecutive expressions on a line must be separated by ';' or a \
            newline")
  | _ -> ()

and parse_expr_block_item p =
  let start_pos = Parser.start_pos p in
  let attrs = parse_attributes p in
  match Parser.peek p with
  | Break ->
    Parser.next p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.break ~loc ~attrs ()
  | Continue ->
    Parser.next p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.continue ~loc ~attrs ()
  | Module -> (
    Parser.next p;
    match Parser.peek p with
    | Lparen ->
      let expr = parse_first_class_module_expr ~start_pos p in
      let a = parse_primary_expr ~operand:expr p in
      let expr = parse_binary_expr ~a p 1 in
      parse_ternary_expr expr p
    | _ ->
      let name =
        match Parser.peek p with
        | Uident ident ->
          let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
          Parser.next p;
          Location.mkloc ident loc
        | t ->
          Parser.err p (Diagnostics.uident t);
          Location.mknoloc "_"
      in
      let body = parse_module_binding_body p in
      parse_newline_or_semicolon_expr_block p;
      let expr = parse_expr_block p in
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Exp.letmodule ~loc name body expr)
  | Exception ->
    let extension_constructor = parse_exception_def ~attrs p in
    parse_newline_or_semicolon_expr_block p;
    let block_expr = parse_expr_block p in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.letexception ~loc extension_constructor block_expr
  | Open ->
    let od = parse_open_description ~attrs p in
    parse_newline_or_semicolon_expr_block p;
    let block_expr = parse_expr_block p in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.open_ ~loc od.popen_override od.popen_lid block_expr
  | Let {unwrap} ->
    let rec_flag, let_bindings =
      parse_let_bindings ~unwrap ~attrs ~start_pos p
    in
    parse_newline_or_semicolon_expr_block p;
    let next =
      if Grammar.is_block_expr_start (Parser.peek p) then parse_expr_block p
      else
        let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
        Ast_helper.Exp.construct ~loc
          (Location.mkloc (Longident.Lident "()") loc)
          (Location.mkloc [] loc)
    in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.let_ ~loc rec_flag let_bindings next
  | Typ ->
    (* Parse to be able to give a good error message. *)
    let type_start = start_pos in
    Parser.begin_region p;
    let _ = parse_type_definition_or_extension ~attrs p in
    Parser.end_region p;
    Parser.err ~start_pos:type_start ~end_pos:(Parser.position p) p
      (Diagnostics.message Error_messages.type_definition_in_function);
    parse_newline_or_semicolon_expr_block p;
    parse_expr_block p
  | _ ->
    let e1 =
      let expr = parse_expr p in
      {expr with pexp_attributes = List.concat [attrs; expr.pexp_attributes]}
    in
    parse_newline_or_semicolon_expr_block p;
    if Grammar.is_block_expr_start (Parser.peek p) then
      let e2 = parse_expr_block p in
      let loc = {e1.pexp_loc with loc_end = e2.pexp_loc.loc_end} in
      Ast_helper.Exp.sequence ~loc e1 e2
    else e1

(* blockExpr ::= expr
 *            |  expr          ;
 *            |  expr          ; blockExpr
 *            |  module    ... ; blockExpr
 *            |  open      ... ; blockExpr
 *            |  exception ... ; blockExpr
 *            |  let       ...
 *            |  let       ... ;
 *            |  let       ... ; blockExpr
 *
 *  note: semi should be made optional
 *  a block of expression is always
 *)
and parse_expr_block ?first p =
  Parser.leave_breadcrumb p Grammar.ExprBlock;
  let item =
    match first with
    | Some e -> e
    | None -> parse_expr_block_item p
  in
  parse_newline_or_semicolon_expr_block p;
  let block_expr =
    if Grammar.is_block_expr_start (Parser.peek p) then
      let next = parse_expr_block_item p in
      let loc = {item.pexp_loc with loc_end = next.pexp_loc.loc_end} in
      Ast_helper.Exp.sequence ~loc item next
    else item
  in
  Parser.eat_breadcrumb p;
  over_parse_constrained_or_coerced_or_arrow_expression p block_expr

and parse_async_arrow_expression ?(arrow_attrs = []) p =
  Parser.expect (Lident "async") p;
  parse_es6_arrow_expression ~async:true ~arrow_attrs p

and parse_await_expression p =
  let await_loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
  Parser.expect Await p;
  let token_prec = Token.precedence MinusGreater in
  let expr = parse_binary_expr ~context:OrdinaryExpr p token_prec in
  Ast_helper.Exp.await
    ~loc:{expr.pexp_loc with loc_start = await_loc.loc_start}
    ~attrs:[] expr

and parse_try_expression p =
  let start_pos = Parser.start_pos p in
  Parser.expect Try p;
  let expr = parse_expr ~context:WhenExpr p in
  let cases, finally =
    if Parser.peek p = Res_token.finally then ([], Some (parse_finally_block p))
    else (
      Parser.expect Res_token.catch p;
      Parser.expect Lbrace p;
      let cases = parse_pattern_matching p in
      Parser.expect Rbrace p;
      (* [finally] is not a keyword. After a catch it only starts a finally
         block when a brace follows, so a statement after the try can still
         use a [finally] identifier. *)
      let finally =
        if Parser.peek p = Res_token.finally && Parser.peek2 p = Lbrace then
          Some (parse_finally_block p)
        else None
      in
      (cases, finally))
  in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Exp.try_ ~loc ?finally expr cases

and parse_finally_block p =
  if Parser.peek2 p <> Lbrace then
    Parser.err p
      (Diagnostics.message "A `finally` block needs braces: `finally { ... }`");
  Parser.next p;
  match Parser.peek p with
  | Lbrace ->
    Parser.next p;
    let finally = parse_expr_block p in
    Parser.expect Rbrace p;
    finally
  | _ -> parse_expr p

and parse_if_condition p =
  Parser.leave_breadcrumb p Grammar.IfCondition;
  (* doesn't make sense to try es6 arrow here? *)
  let condition_expr = parse_expr ~context:WhenExpr p in
  Parser.eat_breadcrumb p;
  condition_expr

and parse_then_branch p =
  Parser.leave_breadcrumb p IfBranch;
  Parser.expect Lbrace p;
  let then_expr = parse_expr_block p in
  Parser.expect Rbrace p;
  Parser.eat_breadcrumb p;
  then_expr

and parse_else_branch p =
  Parser.expect Lbrace p;
  let block_expr = parse_expr_block p in
  Parser.expect Rbrace p;
  block_expr

and parse_if_expr start_pos p =
  let condition_expr = parse_if_condition p in
  let then_expr = parse_then_branch p in
  let else_expr =
    match Parser.peek p with
    | Else ->
      Parser.end_region p;
      Parser.leave_breadcrumb p Grammar.ElseBranch;
      Parser.next p;
      Parser.begin_region p;
      let else_expr =
        match Parser.peek p with
        | If -> parse_if_or_if_let_expression p
        | _ -> parse_else_branch p
      in
      Parser.eat_breadcrumb p;
      Parser.end_region p;
      Some else_expr
    | _ ->
      Parser.end_region p;
      None
  in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Exp.ifthenelse ~loc condition_expr then_expr else_expr

and parse_if_let_expr start_pos p =
  let pattern = parse_pattern p in
  Parser.expect Equal p;
  let condition_expr = parse_if_condition p in
  let then_expr = parse_then_branch p in
  let else_expr =
    match Parser.peek p with
    | Else ->
      Parser.end_region p;
      Parser.leave_breadcrumb p Grammar.ElseBranch;
      Parser.next p;
      Parser.begin_region p;
      let else_expr =
        match Parser.peek p with
        | If -> parse_if_or_if_let_expression p
        | _ -> parse_else_branch p
      in
      Parser.eat_breadcrumb p;
      Parser.end_region p;
      else_expr
    | _ ->
      Parser.end_region p;
      let start_pos = Parser.start_pos p in
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Exp.construct ~loc
        (Location.mkloc (Longident.Lident "()") loc)
        (Location.mkloc [] loc)
  in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Exp.match_ ~loc condition_expr
    [
      Ast_helper.Exp.case pattern then_expr;
      Ast_helper.Exp.case (Ast_helper.Pat.any ()) else_expr;
    ]

and parse_if_or_if_let_expression p =
  Parser.begin_region p;
  Parser.leave_breadcrumb p Grammar.ExprIf;
  let start_pos = Parser.start_pos p in
  Parser.expect If p;
  let expr =
    match Parser.peek p with
    | Let _ ->
      Parser.next p;
      let if_let_expr = parse_if_let_expr start_pos p in
      Parser.err ~start_pos:if_let_expr.pexp_loc.loc_start
        ~end_pos:if_let_expr.pexp_loc.loc_end p
        (Diagnostics.message (Error_messages.experimental_if_let if_let_expr));
      if_let_expr
    | _ -> parse_if_expr start_pos p
  in
  Parser.eat_breadcrumb p;
  expr

and normalize_for_of_pattern p pattern =
  match pattern.Parsetree.ppat_desc with
  | Ppat_any | Ppat_var _ -> pattern
  | _ ->
    Parser.err ~start_pos:pattern.ppat_loc.loc_start
      ~end_pos:pattern.ppat_loc.loc_end p
      (Diagnostics.message
         "A `for...of` or `for await...of` loop only supports a variable or \
          `_` on the left side. Destructuring patterns are not supported here.");
    Ast_helper.Pat.any ~loc:pattern.ppat_loc ()

and parse_for_rest has_opening_paren ~await pattern start_pos p =
  let parse_loop_body () =
    if has_opening_paren then Parser.expect Rparen p;
    Parser.expect Lbrace p;
    let body_expr = parse_expr_block p in
    Parser.expect Rbrace p;
    body_expr
  in
  match Parser.peek p with
  | Of ->
    (* for...of loop *)
    Parser.next p;
    let pattern = normalize_for_of_pattern p pattern in
    let array_expr = parse_expr ~context:WhenExpr p in
    let body_expr = parse_loop_body () in
    let loc = mk_loc start_pos (Parser.position p) in
    if await then Ast_helper.Exp.for_await_of ~loc pattern array_expr body_expr
    else Ast_helper.Exp.for_of ~loc pattern array_expr body_expr
  | In ->
    if await then
      Parser.err ~start_pos p
        (Diagnostics.message
           "A `for await` loop must use `of`, like `for await item of items`.");
    (* regular for loop *)
    Parser.next p;
    let e1 = parse_expr p in
    let direction =
      match Parser.peek p with
      | Lident "to" -> Asttypes.Upto
      | Lident "downto" -> Asttypes.Downto
      | token ->
        Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
        Asttypes.Upto
    in
    if Parser.peek p = Eof then
      Parser.err ~start_pos:(Parser.start_pos p) p
        (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs)
    else Parser.next p;
    let e2 = parse_expr ~context:WhenExpr p in
    let body_expr = parse_loop_body () in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.for_ ~loc pattern e1 e2 direction body_expr
  | _ ->
    Parser.err p
      (Diagnostics.message
         "A for-loop has the following form: `for i in 0 to 10` or `for item \
          of items`. Did you forget an `in` or `of` here?");
    Recover.default_expr ()

and parse_for_expression p =
  let start_pos = Parser.start_pos p in
  Parser.leave_breadcrumb p Grammar.ExprFor;
  Parser.expect For p;
  Parser.begin_region p;
  let for_expr =
    match Parser.peek p with
    | Lparen -> (
      let lparen = Parser.start_pos p in
      Parser.next p;
      match Parser.peek p with
      | Rparen ->
        Parser.next p;
        let unit_pattern =
          let loc = mk_loc lparen (Parser.position p) in
          let lid = Location.mkloc (Longident.Lident "()") loc in
          Ast_helper.Pat.construct lid {txt = []; loc}
        in
        parse_for_rest false ~await:false
          (parse_alias_pattern ~attrs:[] unit_pattern p)
          start_pos p
      | _ -> (
        Parser.leave_breadcrumb p Grammar.Pattern;
        let pat = parse_pattern p in
        Parser.eat_breadcrumb p;
        match Parser.peek p with
        | Comma ->
          Parser.next p;
          let tuple_pattern =
            parse_tuple_pattern ~attrs:[] ~start_pos:lparen ~first:pat p
          in
          let pattern = parse_alias_pattern ~attrs:[] tuple_pattern p in
          parse_for_rest false ~await:false pattern start_pos p
        | _ -> parse_for_rest true ~await:false pat start_pos p))
    | Await -> (
      Parser.next p;
      match Parser.peek p with
      | Lparen -> (
        let lparen = Parser.start_pos p in
        Parser.next p;
        match Parser.peek p with
        | Rparen ->
          Parser.next p;
          let unit_pattern =
            let loc = mk_loc lparen (Parser.position p) in
            let lid = Location.mkloc (Longident.Lident "()") loc in
            Ast_helper.Pat.construct lid {txt = []; loc}
          in
          parse_for_rest false ~await:true
            (parse_alias_pattern ~attrs:[] unit_pattern p)
            start_pos p
        | _ -> (
          Parser.leave_breadcrumb p Grammar.Pattern;
          let pat = parse_pattern p in
          Parser.eat_breadcrumb p;
          match Parser.peek p with
          | Comma ->
            Parser.next p;
            let tuple_pattern =
              parse_tuple_pattern ~attrs:[] ~start_pos:lparen ~first:pat p
            in
            let pattern = parse_alias_pattern ~attrs:[] tuple_pattern p in
            parse_for_rest false ~await:true pattern start_pos p
          | _ -> parse_for_rest true ~await:true pat start_pos p))
      | _ ->
        Parser.leave_breadcrumb p Grammar.Pattern;
        let pat = parse_pattern p in
        Parser.eat_breadcrumb p;
        parse_for_rest false ~await:true pat start_pos p)
    | _ ->
      Parser.leave_breadcrumb p Grammar.Pattern;
      let pat = parse_pattern p in
      Parser.eat_breadcrumb p;
      parse_for_rest false ~await:false pat start_pos p
  in
  Parser.eat_breadcrumb p;
  Parser.end_region p;
  for_expr

and parse_while_expression p =
  let start_pos = Parser.start_pos p in
  Parser.expect While p;
  let expr1 = parse_expr ~context:WhenExpr p in
  Parser.expect Lbrace p;
  let expr2 = parse_expr_block p in
  Parser.expect Rbrace p;
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Exp.while_ ~loc expr1 expr2

and parse_pattern_guard p =
  match Parser.peek p with
  | When | If ->
    Parser.next p;
    Some (parse_expr ~context:GuardExpr p)
  | _ -> None

and parse_pattern_match_case p =
  Parser.begin_region p;
  Parser.leave_breadcrumb p Grammar.PatternMatchCase;
  match Parser.peek p with
  | Token.Bar ->
    let bar = Parser.start_pos p in
    Parser.next p;
    Parser.leave_breadcrumb p Grammar.Pattern;
    let lhs = parse_pattern p in
    Parser.eat_breadcrumb p;
    let guard = parse_pattern_guard p in
    let () =
      match Parser.peek p with
      | EqualGreater -> Parser.next p
      | _ -> Recover.recover_equal_greater p
    in
    let rhs = parse_expr_block p in
    Parser.end_region p;
    Parser.eat_breadcrumb p;
    Some (Ast_helper.Exp.case ~bar lhs ?guard rhs)
  | _ ->
    Parser.end_region p;
    Parser.eat_breadcrumb p;
    None

and parse_pattern_matching p =
  let cases =
    parse_delimited_region ~grammar:Grammar.PatternMatching ~closing:Rbrace
      ~f:parse_pattern_match_case p
  in
  let () =
    match cases with
    | [] ->
      Parser.err ~start_pos:(Parser.position p) p
        (Diagnostics.message "Pattern matching needs at least one case")
    | _ -> ()
  in
  cases

and parse_switch_expression p =
  let start_pos = Parser.start_pos p in
  Parser.expect Switch p;
  let switch_expr = parse_expr ~context:WhenExpr p in
  Parser.expect Lbrace p;
  let cases = parse_pattern_matching p in
  Parser.expect Rbrace p;
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Exp.match_ ~loc switch_expr cases

(*
 * argument ::=
 *   | _                            (* syntax sugar *)
 *   | expr
 *   | expr : type
 *   | ~ label-name
 *   | ~ label-name
 *   | ~ label-name ?
 *   | ~ label-name =   expr
 *   | ~ label-name =   _           (* syntax sugar *)
 *   | ~ label-name =   expr : type
 *   | ~ label-name = ? expr
 *   | ~ label-name = ? _           (* syntax sugar *)
 *   | ~ label-name = ? expr : type
 *
 *  dotted_argument ::=
 *   | . argument                   (* deprecated uncurried syntax *)
 *)
and parse_argument p : argument option =
  if
    Parser.peek p = Token.Tilde
    || Parser.peek p = Dot
    || Parser.peek p = Underscore
    || Grammar.is_expr_start (Parser.peek p)
  then
    match Parser.peek p with
    | Dot -> (
      let dot_loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      warn_uncurried_dot_syntax p ~loc:dot_loc;
      match Parser.peek p with
      (* apply(.) — legacy uncurried unit call *)
      | Rparen ->
        let unit_expr =
          Ast_helper.Exp.construct
            (Location.mknoloc (Longident.Lident "()"))
            (Location.mknoloc [])
        in
        Some {label = Asttypes.Nolabel; expr = unit_expr}
      | _ -> parse_argument2 p)
    | _ -> parse_argument2 p
  else None

and parse_argument2 p : argument option =
  match Parser.peek p with
  (* foo(_), do not confuse with foo(_ => x), TODO: performance *)
  | Underscore when not (is_es6_arrow_expression ~in_ternary:false p) ->
    let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
    Parser.next p;
    let expr =
      Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc)
    in
    Some {label = Nolabel; expr}
  | Tilde -> (
    Parser.next p;
    (* TODO: nesting of pattern matches not intuitive for error recovery *)
    match Parser.peek p with
    | Lident ident -> (
      let start_pos = Parser.start_pos p in
      Parser.next p;
      let end_pos = Parser.position p in
      let loc = mk_loc start_pos end_pos in
      let named_arg_loc = loc in
      let ident_expr =
        Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident ident) loc)
      in
      match Parser.peek p with
      | Question ->
        Parser.next p;
        Some
          {
            label = Optional {txt = ident; loc = named_arg_loc};
            expr = ident_expr;
          }
      | Equal ->
        Parser.next p;
        let label =
          match Parser.peek p with
          | Question ->
            Parser.next p;
            Asttypes.Optional {txt = ident; loc = named_arg_loc}
          | _ -> Asttypes.Labelled {txt = ident; loc = named_arg_loc}
        in
        let expr =
          match Parser.peek p with
          | Underscore when not (is_es6_arrow_expression ~in_ternary:false p) ->
            let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
            Parser.next p;
            Ast_helper.Exp.ident ~loc
              (Location.mkloc (Longident.Lident "_") loc)
          | _ -> parse_constrained_or_coerced_expr p
        in
        Some {label; expr}
      | Colon ->
        let colon_start = Parser.start_pos p in
        Parser.next p;
        let colon_end = Parser.position p in
        if Grammar.is_typ_expr_start (Parser.peek p) then
          let typ = parse_typ_expr p in
          let loc = mk_loc start_pos (Parser.position p) in
          let expr = Ast_helper.Exp.constraint_ ~loc ident_expr typ in
          Some
            {label = Asttypes.Labelled {txt = ident; loc = named_arg_loc}; expr}
        else
          let label, expr =
            match Parser.peek p with
            | Question ->
              Parser.err ~start_pos:colon_start ~end_pos:colon_end p
                (Diagnostics.message
                   Error_messages.optional_labelled_argument_missing_equal);
              Parser.next p;
              let expr = parse_constrained_or_coerced_expr p in
              (Asttypes.Optional {txt = ident; loc = named_arg_loc}, expr)
            | _ ->
              Parser.err ~start_pos:colon_start ~end_pos:colon_end p
                (Diagnostics.message
                   Error_messages.labelled_argument_missing_equal);
              let expr =
                match Parser.peek p with
                | Underscore
                  when not (is_es6_arrow_expression ~in_ternary:false p) ->
                  let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
                  Parser.next p;
                  Ast_helper.Exp.ident ~loc
                    (Location.mkloc (Longident.Lident "_") loc)
                | _ -> parse_constrained_or_coerced_expr p
              in
              (Asttypes.Labelled {txt = ident; loc = named_arg_loc}, expr)
          in
          Some {label; expr}
      | _ ->
        Some
          {
            label = Asttypes.Labelled {txt = ident; loc = named_arg_loc};
            expr = ident_expr;
          })
    | t ->
      Parser.err p (Diagnostics.lident t);
      Some {label = Nolabel; expr = Recover.default_expr ()})
  | _ -> Some {label = Nolabel; expr = parse_constrained_or_coerced_expr p}

and parse_call_expr p fun_expr =
  Parser.expect Lparen p;
  let start_pos = Parser.start_pos p in
  Parser.leave_breadcrumb p Grammar.ExprCall;
  let args =
    parse_comma_delimited_region ~grammar:Grammar.ArgumentList ~closing:Rparen
      ~f:parse_argument p
  in
  let partial =
    match Parser.peek p with
    | DotDotDot when args <> [] ->
      Parser.next p;
      true
    | _ -> false
  in
  Parser.expect Rparen p;
  let args =
    match args with
    | [] ->
      let loc = mk_loc start_pos (Parser.position p) in
      (* No args -> unit sugar: `foo()` *)
      [
        {
          label = Nolabel;
          expr =
            Ast_helper.Exp.construct ~loc
              (Location.mkloc (Longident.Lident "()") loc)
              (Location.mkloc [] loc);
        };
      ]
    | args -> args
  in
  let loc = {fun_expr.pexp_loc with loc_end = Parser.position p} in
  let args =
    match args with
    | {label = lbl; expr} :: args ->
      let group (grp, acc) {label = lbl; expr} = ((lbl, expr) :: grp, acc) in
      let grp, acc = List.fold_left group ([(lbl, expr)], []) args in
      List.rev (List.rev grp :: acc)
    | [] -> []
  in
  let apply =
    Ext_list.fold_left args fun_expr (fun call_body args ->
        let args, wrap = process_underscore_application args in
        let exp = Ast_helper.Exp.apply ~loc ~partial call_body args in
        wrap exp)
  in

  Parser.eat_breadcrumb p;
  apply

and parse_value_or_constructor p =
  let start_pos = Parser.start_pos p in
  let rec aux p acc =
    match Parser.peek p with
    | Uident ident -> (
      let end_pos_lident = Parser.end_pos p in
      Parser.next p;
      match Parser.peek p with
      | Dot ->
        Parser.next p;
        aux p (ident :: acc)
      | Lparen
        when (Parser.position p).pos_lnum == (Parser.start_pos p).pos_lnum ->
        let args = parse_constructor_args p in
        let lident = build_longident (ident :: acc) in
        let loc = mk_loc start_pos args.loc.loc_end in
        let ident_loc = mk_loc start_pos end_pos_lident in
        Ast_helper.Exp.construct ~loc (Location.mkloc lident ident_loc) args
      | _ ->
        let loc = mk_loc start_pos (Parser.position p) in
        let lident = build_longident (ident :: acc) in
        Ast_helper.Exp.construct ~loc
          (Location.mkloc lident loc)
          (Location.mkloc [] loc))
    | Lident ident ->
      Parser.next p;
      let loc = mk_loc start_pos (Parser.position p) in
      let lident = build_longident (ident :: acc) in
      Ast_helper.Exp.ident ~loc (Location.mkloc lident loc)
    | token ->
      if acc = [] then (
        Parser.next_unsafe p;
        Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
        Recover.default_expr ())
      else
        let loc = mk_loc start_pos (Parser.position p) in
        Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
        let lident = build_longident ("_" :: acc) in
        Ast_helper.Exp.ident ~loc (Location.mkloc lident loc)
  in
  aux p []

and parse_poly_variant_expr p =
  let start_pos = Parser.start_pos p in
  let ident, _loc = parse_hash_ident ~start_pos p in
  match Parser.peek p with
  | Lparen when (Parser.position p).pos_lnum == (Parser.start_pos p).pos_lnum ->
    let args = parse_constructor_args p in
    let loc = mk_loc start_pos args.loc.loc_end in
    Ast_helper.Exp.variant ~loc ident args
  | _ ->
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Exp.variant ~loc ident (Location.mkloc [] loc)

and parse_constructor_args p : Parsetree.expression list Location.loc =
  let lparen = Parser.start_pos p in
  Parser.expect Lparen p;
  let args =
    parse_comma_delimited_region ~grammar:Grammar.ExprList
      ~f:parse_constrained_expr_region ~closing:Rparen p
  in
  Parser.expect Rparen p;
  let loc = mk_loc lparen (Parser.position p) in
  let args =
    match args with
    | [] ->
      [
        Ast_helper.Exp.construct ~loc
          (Location.mkloc (Longident.Lident "()") loc)
          (Location.mkloc [] loc);
      ]
    | args -> args
  in
  Location.mkloc args loc

and parse_tuple_expr ~first ~start_pos p =
  let exprs =
    first
    :: parse_comma_delimited_region p ~grammar:Grammar.ExprList ~closing:Rparen
         ~f:parse_constrained_expr_region
  in
  Parser.expect Rparen p;
  let () =
    match exprs with
    | [_] ->
      Parser.err ~start_pos ~end_pos:(Parser.position p) p
        (Diagnostics.message Error_messages.tuple_single_element)
    | _ -> ()
  in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Exp.tuple ~loc exprs

and parse_spread_element_region p =
  match Parser.peek p with
  | DotDotDot ->
    Parser.next p;
    Some (Parsetree.Pspread (parse_constrained_or_coerced_expr p))
  | token when Grammar.is_expr_start token ->
    Some (Parsetree.Pspread_item (parse_constrained_or_coerced_expr p))
  | _ -> None

and parse_list_expr ~start_pos p =
  let elements =
    parse_comma_delimited_region p ~grammar:Grammar.ListExpr ~closing:Rbrace
      ~f:parse_spread_element_region
  in
  Parser.expect Rbrace p;
  let loc = mk_loc start_pos (Parser.position p) in
  (* Items, possibly followed by a spread, are a chain of [::] *)
  let rec items_and_tail acc = function
    | [] -> Some (List.rev acc, None)
    | [Parsetree.Pspread tail] -> Some (List.rev acc, Some tail)
    | Parsetree.Pspread_item item :: rest -> items_and_tail (item :: acc) rest
    | Pspread _ :: _ -> None
  in
  match items_and_tail [] elements with
  | Some (items, tail) -> Ast_helper.Exp.make_list_expression loc items tail
  | None -> Ast_helper.Exp.spread ~loc Spread_list elements

and parse_dict_expr ~start_pos p =
  let entries =
    parse_comma_delimited_region ~grammar:Grammar.DictRows ~closing:Rbrace
      ~f:parse_dict_expr_part p
  in
  let loc = mk_loc start_pos (Parser.end_pos p) in
  Parser.expect Rbrace p;
  Ast_helper.Exp.dict ~loc entries

and parse_array_exp p =
  let start_pos = Parser.start_pos p in
  Parser.expect Lbracket p;
  let elements =
    parse_comma_delimited_region p ~grammar:Grammar.ExprList ~closing:Rbracket
      ~f:parse_spread_element_region
  in
  Parser.expect Rbracket p;
  let loc = mk_loc start_pos (Parser.position p) in
  let items =
    List.filter_map
      (function
        | Parsetree.Pspread_item item -> Some item
        | Pspread _ -> None)
      elements
  in
  if List.length items = List.length elements then
    Ast_helper.Exp.array ~loc items
  else Ast_helper.Exp.spread ~loc Spread_array elements

(* TODO: check attributes in the case of poly type vars,
 * might be context dependend: parseFieldDeclaration (see ocaml) *)
and parse_poly_type_expr ?current_type_name_path ?inline_types_context p =
  let start_pos = Parser.start_pos p in
  match Parser.peek p with
  | SingleQuote -> (
    let vars = parse_type_var_list p in
    match vars with
    | _v1 :: _v2 :: _ ->
      Parser.expect Dot p;
      let typ = parse_typ_expr p in
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Typ.poly ~loc vars typ
    | [var] -> (
      match Parser.peek p with
      | Dot ->
        Parser.next p;
        let typ = parse_typ_expr p in
        let loc = mk_loc start_pos (Parser.position p) in
        Ast_helper.Typ.poly ~loc vars typ
      | EqualGreater ->
        Parser.next p;
        let typ = Ast_helper.Typ.var ~loc:var.loc var.txt in
        let return_type = parse_typ_expr ~alias:false p in
        let loc = mk_loc typ.Parsetree.ptyp_loc.loc_start (Parser.position p) in
        Ast_helper.Typ.arrow ~loc
          [Parg_type {attrs = []; lbl = Nolabel; typ}]
          return_type
      | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt)
    | _ -> assert false)
  | _ -> parse_typ_expr ?current_type_name_path ?inline_types_context p

(* 'a 'b 'c *)
and parse_type_var_list p =
  let rec loop p vars =
    match Parser.peek p with
    | SingleQuote ->
      Parser.next p;
      let lident, loc =
        parse_ident ~msg:Error_messages.type_param
          ~start_pos:(Parser.start_pos p) p
      in
      let var = Location.mkloc lident loc in
      loop p (var :: vars)
    | _ -> List.rev vars
  in
  loop p []

and parse_lident_list p =
  let rec loop p ls =
    match Parser.peek p with
    | Lident lident ->
      let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      loop p (Location.mkloc lident loc :: ls)
    | _ -> List.rev ls
  in
  loop p []

and parse_atomic_typ_expr ?current_type_name_path ?inline_types_context ~attrs p
    =
  Parser.leave_breadcrumb p Grammar.AtomicTypExpr;
  let start_pos = Parser.start_pos p in
  let typ =
    match Parser.peek p with
    | SingleQuote ->
      Parser.next p;
      let ident, loc =
        if Parser.peek p = Eof then (
          Parser.err ~start_pos:(Parser.start_pos p) p
            (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs);
          ("", mk_loc (Parser.start_pos p) (Parser.position p)))
        else
          parse_ident ~msg:Error_messages.type_var
            ~start_pos:(Parser.start_pos p) p
      in
      maybe_track_inline_type_param inline_types_context ident loc;
      Ast_helper.Typ.var ~loc ~attrs ident
    | Underscore ->
      let end_pos = Parser.end_pos p in
      Parser.next p;
      Ast_helper.Typ.any ~loc:(mk_loc start_pos end_pos) ~attrs ()
    | Lparen -> (
      Parser.next p;
      match Parser.peek p with
      | Rparen ->
        Parser.next p;
        let loc = mk_loc start_pos (Parser.position p) in
        let unit_constr = Location.mkloc (Longident.Lident "unit") loc in
        Ast_helper.Typ.constr ~attrs unit_constr []
      | _ -> (
        let t = parse_typ_expr p in
        match Parser.peek p with
        | Comma ->
          Parser.next p;
          parse_tuple_type ~attrs ~first:t ~start_pos p
        | _ ->
          Parser.expect Rparen p;
          {
            t with
            ptyp_loc = mk_loc start_pos (Parser.position p);
            ptyp_attributes = List.concat [attrs; t.ptyp_attributes];
          }))
    | Lbracket -> parse_polymorphic_variant_type ~attrs p
    | Uident _ | Lident _ ->
      let constr = parse_value_path p in
      let args =
        parse_type_constructor_args ?inline_types_context
          ?current_type_name_path ~constr_name:constr p
      in
      let number_of_inline_records_in_args =
        match inline_types_context with
        | None -> 0
        | Some inline_types_context ->
          let inline_types = inline_types_context.found_inline_types in
          args
          |> List.filter (fun (c : Parsetree.core_type) ->
              match c.ptyp_desc with
              | Ptyp_constr ({txt = Lident typename}, _) ->
                inline_types
                |> List.exists (fun inline_type -> inline_type.name = typename)
              | _ -> false)
          |> List.length
      in
      if number_of_inline_records_in_args > 1 then
        Parser.err ~start_pos ~end_pos:(Parser.position p) p
          (Diagnostics.message
             Error_messages.multiple_inline_record_definitions_at_same_path);
      Ast_helper.Typ.constr
        ~loc:(mk_loc start_pos (Parser.position p))
        ~attrs constr args
    | Module ->
      Parser.next p;
      Parser.expect Lparen p;
      let package_type = parse_package_type ~start_pos ~attrs p in
      Parser.expect Rparen p;
      {package_type with ptyp_loc = mk_loc start_pos (Parser.position p)}
    | Percent ->
      let extension = parse_extension p in
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Typ.extension ~attrs ~loc extension
    | Lbrace ->
      parse_record_or_object_type ?current_type_name_path ?inline_types_context
        ~attrs p
    | Eof ->
      Parser.err p (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs);
      Recover.default_type ()
    | token -> (
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      match
        skip_tokens_and_maybe_retry p
          ~is_start_of_grammar:Grammar.is_atomic_typ_expr_start
      with
      | Some () -> parse_atomic_typ_expr ~attrs p
      | None ->
        Parser.err ~start_pos:(Parser.position p) p
          (Diagnostics.unexpected token p.breadcrumbs);
        Recover.default_type ())
  in
  Parser.eat_breadcrumb p;
  typ

(* package-type	::=
    | modtype-path
    ∣ modtype-path with package-constraint  { and package-constraint }
*)
and parse_package_type ~start_pos ~attrs p =
  let mod_type_path = parse_module_long_ident ~lowercase:true p in
  match Parser.peek p with
  | Lident "with" ->
    Parser.next p;
    let constraints = parse_package_constraints p in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Typ.package ~loc ~attrs mod_type_path constraints
  | _ ->
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Typ.package ~loc ~attrs mod_type_path []

(* package-constraint  { and package-constraint } *)
and parse_package_constraints p =
  let first =
    Parser.expect Typ p;
    let type_constr = parse_value_path p in
    Parser.expect Equal p;
    let typ = parse_typ_expr p in
    (type_constr, typ)
  in
  let rest =
    parse_region ~grammar:Grammar.PackageConstraint ~f:parse_package_constraint
      p
  in
  first :: rest

(* and type typeconstr = typexpr *)
and parse_package_constraint p =
  match Parser.peek p with
  | And ->
    Parser.next p;
    Parser.expect Typ p;
    let type_constr = parse_value_path p in
    Parser.expect Equal p;
    let typ = parse_typ_expr p in
    Some (type_constr, typ)
  | _ -> None

and parse_record_or_object_type ?current_type_name_path ?inline_types_context
    ~attrs p =
  (* for inline record in constructor *)
  let start_pos = Parser.start_pos p in
  Parser.expect Lbrace p;
  let closed_flag =
    match Parser.peek p with
    | DotDot ->
      Parser.next p;
      Asttypes.Open
    | Dot ->
      Parser.next p;
      Asttypes.Closed
    | _ -> Asttypes.Closed
  in
  match (inline_types_context, current_type_name_path) with
  | Some inline_types_context, Some current_type_name_path
    when Grammar.is_field_decl_start (Parser.peek p) ->
    let labels =
      parse_comma_delimited_region ~grammar:Grammar.RecordDecl ~closing:Rbrace
        ~f:
          (parse_field_declaration_region ~current_type_name_path
             ~inline_types_context)
        p
    in
    Parser.expect Rbrace p;
    let loc = mk_loc start_pos (Parser.position p) in
    let inline_type_name = current_type_name_path |> String.concat "." in
    let params = inline_types_context.params in

    inline_types_context.found_inline_types <-
      {
        name = inline_type_name;
        loc;
        kind = Parsetree.Ptype_record labels;
        params;
      }
      :: inline_types_context.found_inline_types;

    let lid = Location.mkloc (Longident.Lident inline_type_name) loc in
    Ast_helper.Typ.constr ~loc lid (params |> List.map fst)
  | _ ->
    let () =
      match Parser.peek p with
      | Lident _ ->
        Parser.err p
          (Diagnostics.message
             Error_messages.forbidden_inline_record_declaration)
      | _ -> ()
    in
    let fields =
      parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations
        ~closing:Rbrace ~f:parse_string_field_declaration p
    in
    Parser.expect Rbrace p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Typ.object_ ~loc ~attrs fields closed_flag

(* TODO: check associativity in combination with attributes *)
and parse_type_alias p typ =
  match Parser.peek p with
  | As ->
    Parser.next p;
    Parser.expect SingleQuote p;
    let ident, _loc =
      parse_ident ~msg:Error_messages.type_param ~start_pos:(Parser.start_pos p)
        p
    in
    (* TODO: how do we parse attributes here? *)
    Ast_helper.Typ.alias
      ~loc:(mk_loc typ.Parsetree.ptyp_loc.loc_start (Parser.position p))
      typ ident
  | _ -> typ

(* type_parameter ::=
 *  | type_expr
 *  | ~ident: type_expr
 *  | ~ident: type_expr=?
 *
 * note:
 *  | attrs ~ident: type_expr    -> attrs are on the arrow
 *  | attrs type_expr            -> attrs are here part of the type_expr
 *
 * dotted_type_parameter ::=
 *  | . type_parameter           (* deprecated uncurried syntax *)
 *)
and parse_type_parameter ?current_type_name_path ?inline_types_context
    ?positional_type_name_path p =
  let doc_attr : Parsetree.attributes =
    match Parser.peek p with
    | DocComment (loc, s) ->
      Parser.next p;
      [doc_comment_to_attribute loc s]
    | _ -> []
  in
  if
    Parser.peek p = Token.Tilde
    || Parser.peek p = Dot
    || Grammar.is_typ_expr_start (Parser.peek p)
  then (
    let start_pos = Parser.start_pos p in
    if Parser.peek p = Token.Dot then (
      let dot_loc = mk_loc start_pos (Parser.end_pos p) in
      Parser.next p;
      warn_uncurried_dot_syntax p ~loc:dot_loc);
    let attrs = doc_attr @ parse_attributes p in
    match Parser.peek p with
    | Tilde -> (
      Parser.next p;
      let name, loc = parse_lident p in
      Parser.expect ~grammar:Grammar.TypeExpression Colon p;
      let arg_path =
        extend_current_type_name_path current_type_name_path name
      in
      let typ =
        parse_typ_expr ?current_type_name_path:arg_path ?inline_types_context p
      in
      match Parser.peek p with
      | Equal ->
        Parser.next p;
        Parser.expect Question p;
        Some {attrs; label = Optional {txt = name; loc}; typ; start_pos}
      | _ -> Some {attrs; label = Labelled {txt = name; loc}; typ; start_pos})
    | Lident _ -> (
      let name, loc = parse_lident p in
      match Parser.peek p with
      | Colon -> (
        let () =
          let error =
            Diagnostics.message
              (Error_messages.missing_tilde_labeled_parameter name)
          in
          Parser.err ~start_pos:loc.loc_start ~end_pos:loc.loc_end p error
        in
        Parser.next p;
        let arg_path =
          extend_current_type_name_path current_type_name_path name
        in
        let typ =
          parse_typ_expr ?current_type_name_path:arg_path ?inline_types_context
            p
        in
        match Parser.peek p with
        | Equal ->
          Parser.next p;
          Parser.expect Question p;
          Some {attrs; label = Optional {txt = name; loc}; typ; start_pos}
        | _ -> Some {attrs; label = Labelled {txt = name; loc}; typ; start_pos})
      | _ ->
        let constr = Location.mkloc (Longident.Lident name) loc in
        let args =
          parse_type_constructor_args ?inline_types_context
            ?current_type_name_path:positional_type_name_path
            ~constr_name:constr p
        in
        let typ =
          Ast_helper.Typ.constr
            ~loc:(mk_loc start_pos (Parser.position p))
            ~attrs constr args
        in

        let typ =
          parse_arrow_type_rest
            ?current_type_name_path:positional_type_name_path
            ?inline_types_context ~es6_arrow:true ~start_pos typ p
        in
        let typ = parse_type_alias p typ in
        Some {attrs = []; label = Nolabel; typ; start_pos})
    | _ ->
      let typ =
        parse_typ_expr ?current_type_name_path:positional_type_name_path
          ?inline_types_context p
      in
      let typ_with_attributes =
        {typ with ptyp_attributes = List.concat [attrs; typ.ptyp_attributes]}
      in
      Some {attrs = []; label = Nolabel; typ = typ_with_attributes; start_pos})
  else None

(* (int, ~x:string, float) *)
and parse_type_parameters ?current_type_name_path ?inline_types_context p =
  let start_pos = Parser.start_pos p in
  Parser.expect Lparen p;
  match Parser.peek p with
  | Rparen ->
    Parser.next p;
    let loc = mk_loc start_pos (Parser.position p) in
    let unit_constr = Location.mkloc (Longident.Lident "unit") loc in
    let typ = Ast_helper.Typ.constr unit_constr [] in
    [{attrs = []; label = Nolabel; typ; start_pos}]
  | _ ->
    let positional_index = ref 0 in
    let params =
      parse_comma_delimited_region ~grammar:Grammar.TypeParameters
        ~closing:Rparen
        ~f:(fun p ->
          let positional_type_name_path =
            make_inline_record_argument_type_name current_type_name_path
              inline_types_context !positional_index
          in
          let parameter =
            parse_type_parameter ?current_type_name_path ?inline_types_context
              ?positional_type_name_path p
          in
          (match parameter with
          | Some _ -> incr positional_index
          | None -> ());
          parameter)
        p
    in
    Parser.expect Rparen p;
    params

and parse_es6_arrow_type ?current_type_name_path ?inline_types_context ~attrs p
    =
  let start_pos = Parser.start_pos p in
  match Parser.peek p with
  | Tilde ->
    Parser.next p;
    let name, label_loc = parse_lident p in
    Parser.expect ~grammar:Grammar.TypeExpression Colon p;
    let arg_path = extend_current_type_name_path current_type_name_path name in
    let typ =
      parse_typ_expr ~alias:false ~es6_arrow:false
        ?current_type_name_path:arg_path ?inline_types_context p
    in
    let lbl =
      match Parser.peek p with
      | Equal ->
        Parser.next p;
        Parser.expect Question p;
        Asttypes.Optional {txt = name; loc = label_loc}
      | _ -> Asttypes.Labelled {txt = name; loc = label_loc}
    in
    Parser.expect EqualGreater p;
    let return_path =
      make_inline_record_return_type_name current_type_name_path
        inline_types_context
    in
    let return_type =
      parse_typ_expr ~alias:false ?current_type_name_path:return_path
        ?inline_types_context p
    in
    let loc = mk_loc start_pos (Parser.position p) in
    (* A bare labeled arrow type [~x: t => u] is a complete one-parameter
       arrow, exactly like its parenthesized form [(~x: t) => u]; it must
       carry the same arity or the two spellings produce types that print
       identically but do not unify. *)
    Ast_helper.Typ.arrow ~loc [Parg_type {attrs; lbl; typ}] return_type
  | DocComment _ -> assert false
  | _ -> (
    let parameters =
      parse_type_parameters ?current_type_name_path ?inline_types_context p
    in
    Parser.expect EqualGreater p;
    let return_path =
      make_inline_record_return_type_name current_type_name_path
        inline_types_context
    in
    let return_type =
      parse_typ_expr ~alias:false ?current_type_name_path:return_path
        ?inline_types_context p
    in
    let params =
      List.map
        (fun {attrs; label = arg_lbl; typ; start_pos = _} ->
          Parsetree.Parg_type {attrs; lbl = arg_lbl; typ})
        parameters
    in
    let loc = mk_loc start_pos (Parser.position p) in
    match params with
    | [] ->
      (* can happen in error recovery *)
      {
        return_type with
        ptyp_attributes = List.concat [return_type.ptyp_attributes; attrs];
        ptyp_loc = loc;
      }
    | _ -> Ast_helper.Typ.arrow ~loc ~attrs params return_type)

(*
 * typexpr ::=
 *  | 'ident
 *  | _
 *  | (typexpr)
 *  | typexpr => typexpr            --> es6 arrow
 *  | (typexpr, typexpr) => typexpr --> es6 arrow
 *  | /typexpr, typexpr, typexpr/  --> tuple
 *  | typeconstr
 *  | typeconstr<typexpr>
 *  | typeconstr<typexpr, typexpr,>
 *  | typexpr as 'ident
 *  | %attr-id                      --> extension
 *  | %attr-id(payload)             --> extension
 *
 * typeconstr ::=
 *  | lident
 *  | uident.lident
 *  | uident.uident.lident     --> long module path
 *)
and parse_typ_expr ?current_type_name_path ?inline_types_context ?attrs
    ?(es6_arrow = true) ?(alias = true) p =
  let start_pos = Parser.start_pos p in
  let attrs =
    match attrs with
    | Some attrs -> attrs
    | None -> parse_attributes p
  in
  let typ =
    if es6_arrow && is_es6_arrow_type p then
      parse_es6_arrow_type ~attrs ?current_type_name_path ?inline_types_context
        p
    else
      let typ =
        parse_atomic_typ_expr ?current_type_name_path ?inline_types_context
          ~attrs p
      in
      parse_arrow_type_rest ?current_type_name_path ?inline_types_context
        ~es6_arrow ~start_pos typ p
  in
  let typ = if alias then parse_type_alias p typ else typ in
  typ

and parse_arrow_type_rest ?current_type_name_path ?inline_types_context
    ~es6_arrow ~start_pos typ p =
  match Parser.peek p with
  | (EqualGreater | MinusGreater) as token when es6_arrow == true ->
    (* error recovery *)
    if token = MinusGreater then Parser.expect EqualGreater p;
    Parser.next p;
    let return_path =
      make_inline_record_return_type_name current_type_name_path
        inline_types_context
    in
    let return_type =
      parse_typ_expr ~alias:false ?current_type_name_path:return_path
        ?inline_types_context p
    in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Typ.arrow ~loc
      [Parg_type {attrs = []; lbl = Nolabel; typ}]
      return_type
  | _ -> typ

and parse_typ_expr_region p =
  if Grammar.is_typ_expr_start (Parser.peek p) then Some (parse_typ_expr p)
  else None

and is_external_bare_arrow_type p =
  Parser.lookahead p (fun state ->
      let attrs = parse_attributes state in
      match Parser.peek state with
      | Lparen | Tilde | DocComment _ -> false
      | _ -> (
        ignore (parse_atomic_typ_expr ~attrs state);
        match Parser.peek state with
        | EqualGreater | MinusGreater -> true
        | _ -> false))

and parse_external_type_expr ~current_type_name_path ~inline_types_context p =
  if is_external_bare_arrow_type p then
    let start_pos = Parser.start_pos p in
    let attrs = parse_attributes p in
    let arg_path =
      make_inline_record_argument_type_name current_type_name_path
        (Some inline_types_context) 0
    in
    let typ =
      parse_atomic_typ_expr ~attrs ?current_type_name_path:arg_path
        ~inline_types_context p
    in
    let typ =
      parse_arrow_type_rest ?current_type_name_path ~inline_types_context
        ~es6_arrow:true ~start_pos typ p
    in
    parse_type_alias p typ
  else if is_es6_arrow_type p then
    parse_typ_expr ?current_type_name_path ~inline_types_context p
  else parse_typ_expr p

and parse_tuple_type ~attrs ~first ~start_pos p =
  let typexprs =
    first
    :: parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen
         ~f:parse_typ_expr_region p
  in
  Parser.expect Rparen p;
  let () =
    match typexprs with
    | [_] ->
      Parser.err ~start_pos ~end_pos:(Parser.position p) p
        (Diagnostics.message Error_messages.tuple_single_element)
    | _ -> ()
  in
  let tuple_loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Typ.tuple ~attrs ~loc:tuple_loc typexprs

and parse_type_constructor_arg_region ?inline_types_context
    ?current_type_name_path p =
  if Grammar.is_typ_expr_start (Parser.peek p) then
    Some (parse_typ_expr ?inline_types_context ?current_type_name_path p)
  else None

(* Nullable.t<'a> *)
and parse_type_constructor_args ?inline_types_context ?current_type_name_path
    ~constr_name p =
  match Parser.peek p with
  | (LessThan | Lparen) as opening ->
    let diagnostic_args =
      if opening = Lparen then (
        let args = ref [] in
        (* Report before recovery to suppress cascading errors. The diagnostic
           is rendered afterwards, using the recovered arguments. *)
        Parser.err p
          (Diagnostics.lazy_message
             (lazy
               (let typ = Ast_helper.Typ.constr constr_name !args in
                Doc.breakable_group ~force_break:true
                  (Doc.concat
                     [
                       Doc.text "Type parameters require angle brackets:";
                       Doc.indent
                         (Doc.concat
                            [
                              Doc.line;
                              Res_printer.print_typ_expr typ Comment_table.empty;
                            ]);
                     ])
                |> Doc.to_string ~width:80)));
        Some args)
      else None
    in
    Parser.next p;
    let closing = get_closing_token opening in
    let type_args =
      parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing
        ~f:
          (parse_type_constructor_arg_region ?inline_types_context
             ?current_type_name_path)
        p
    in
    Parser.expect closing p;
    (match diagnostic_args with
    | Some args -> args := type_args
    | None -> ());
    type_args
  | _ -> []

(* string-field-decl ::=
 *  | string: poly-typexpr
 *  | attributes string-field-decl *)
and parse_string_field_declaration p =
  let attrs = parse_attributes p in
  match Parser.peek p with
  | String name ->
    let name_start_pos = Parser.start_pos p in
    let name_end_pos = Parser.end_pos p in
    Parser.next p;
    let field_name = Location.mkloc name (mk_loc name_start_pos name_end_pos) in
    (match Parser.peek p with
    | Colon -> Parser.next p
    | Equal ->
      Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message Error_messages.record_type_field_missing_colon);
      Parser.next p
    | _ -> Parser.expect ~grammar:Grammar.TypeExpression Colon p);
    let typ = parse_poly_type_expr p in
    Some (Parsetree.Otag (field_name, attrs, typ))
  | DotDotDot ->
    Parser.next p;
    let typ = parse_typ_expr p in
    Some (Parsetree.Oinherit typ)
  | Lident name ->
    let name_loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
    Parser.err p
      (Diagnostics.message (Error_messages.object_quoted_field_name name));
    Parser.next p;
    let field_name = Location.mkloc name name_loc in
    (match Parser.peek p with
    | Colon -> Parser.next p
    | Equal ->
      Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message Error_messages.record_type_field_missing_colon);
      Parser.next p
    | _ -> Parser.expect ~grammar:Grammar.TypeExpression Colon p);
    let typ = parse_poly_type_expr p in
    Some (Parsetree.Otag (field_name, attrs, typ))
  | _token -> None

(* field-decl	::=
 *  | [mutable] field-name : poly-typexpr
 *  | attributes field-decl *)
and parse_field_declaration ?current_type_name_path ?inline_types_context
    ~extra_attrs p =
  let start_pos = Parser.start_pos p in
  (* [extra_attrs] are the attributes of the first field, already consumed by
     the caller before it knew a record was coming. They go through the same
     constructor as the rest so that [@as] is interpreted in one place. *)
  let attrs = extra_attrs @ parse_attributes p in
  let mut =
    if Parser.optional p Token.Mutable then Asttypes.Mutable
    else Asttypes.Immutable
  in
  let lident, loc =
    match Parser.peek p with
    | _ -> parse_lident p
  in
  let optional = parse_optional_label p in
  let name = Location.mkloc lident loc in
  let typ =
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      let current_type_name_path =
        extend_current_type_name_path current_type_name_path name.txt
      in
      parse_poly_type_expr ?current_type_name_path ?inline_types_context p
    | Equal ->
      Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message Error_messages.record_type_field_missing_colon);
      Parser.next p;
      let current_type_name_path =
        extend_current_type_name_path current_type_name_path name.txt
      in
      parse_poly_type_expr ?current_type_name_path ?inline_types_context p
    | _ ->
      Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} []
  in
  let loc = mk_loc start_pos typ.ptyp_loc.loc_end in
  Ast_helper.Type.field ~attrs ~loc ~mut ~optional name typ

and parse_field_declaration_region ?current_type_name_path ?inline_types_context
    ?found_object_field p =
  let start_pos = Parser.start_pos p in
  let attrs = parse_attributes p in
  let mut =
    if Parser.optional p Token.Mutable then Asttypes.Mutable
    else Asttypes.Immutable
  in
  match Parser.peek p with
  | DotDotDot ->
    Parser.next p;
    let name = Location.mkloc "..." (mk_loc start_pos (Parser.position p)) in
    let typ = parse_poly_type_expr p in
    let loc = mk_loc start_pos typ.ptyp_loc.loc_end in
    Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ)
  | String s when found_object_field <> None ->
    Option.get found_object_field := true;
    Parser.next p;
    let name = Location.mkloc s (mk_loc start_pos (Parser.position p)) in
    Parser.expect Colon p;
    let typ = parse_poly_type_expr p in
    let loc = mk_loc start_pos typ.ptyp_loc.loc_end in
    Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ)
  | Lident _ ->
    let lident, loc = parse_lident p in
    let name = Location.mkloc lident loc in
    let current_type_name_path =
      extend_current_type_name_path current_type_name_path name.txt
    in
    let optional = parse_optional_label p in
    let typ =
      match Parser.peek p with
      | Colon ->
        Parser.next p;
        parse_poly_type_expr ?current_type_name_path ?inline_types_context p
      | Equal ->
        Parser.err ~start_pos:(Parser.start_pos p) ~end_pos:(Parser.end_pos p) p
          (Diagnostics.message Error_messages.record_type_field_missing_colon);
        Parser.next p;
        parse_poly_type_expr ?current_type_name_path ?inline_types_context p
      | _ ->
        Ast_helper.Typ.constr ~loc:name.loc ~attrs
          {name with txt = Lident name.txt}
          []
    in
    let loc = mk_loc start_pos typ.ptyp_loc.loc_end in
    Some (Ast_helper.Type.field ~attrs ~loc ~mut ~optional name typ)
  | _ ->
    if Token.is_keyword (Parser.peek p) then (
      match
        recover_keyword_field_name_if_probably_field p
          ~mk_message:Error_messages.keyword_field_in_type
      with
      | Some (recovered_field_name, name_loc) ->
        let optional = parse_optional_label p in
        Parser.expect Colon p;
        let typ =
          parse_poly_type_expr ?current_type_name_path ?inline_types_context p
        in
        let loc = mk_loc start_pos typ.ptyp_loc.loc_end in
        let name = Location.mkloc recovered_field_name name_loc in
        Some (Ast_helper.Type.field ~attrs ~loc ~mut ~optional name typ)
      | None ->
        emit_keyword_field_error p
          ~mk_message:Error_messages.keyword_field_in_type;
        None)
    else (
      if attrs <> [] then
        Parser.err ~start_pos p
          (Diagnostics.message
             "Attributes and doc comments can only be used at the beginning of \
              a field declaration");
      if mut = Mutable then
        Parser.err ~start_pos p
          (Diagnostics.message
             "The `mutable` qualifier can only be used at the beginning of a \
              field declaration");
      None)

(* record-decl ::=
 *  | { field-decl }
 *  | { field-decl, field-decl }
 *  | { field-decl, field-decl, field-decl, }
 *)
and parse_record_declaration ?current_type_name_path ?inline_types_context p =
  Parser.leave_breadcrumb p Grammar.RecordDecl;
  Parser.expect Lbrace p;
  let rows =
    parse_comma_delimited_region ~grammar:Grammar.RecordDecl ~closing:Rbrace
      ~f:
        (parse_field_declaration_region ?current_type_name_path
           ?inline_types_context)
      p
  in
  Parser.expect Rbrace p;
  Parser.eat_breadcrumb p;
  rows

(* constr-args ::=
 *  | (typexpr)
 *  | (typexpr, typexpr)
 *  | (typexpr, typexpr, typexpr,)
 *  | (record-decl)
 *
 * TODO: should we overparse inline-records in every position?
 * Give a good error message afterwards?
 *)
and parse_constr_decl_args p =
  let constr_args =
    match Parser.peek p with
    | Lparen -> (
      Parser.next p;
      (* TODO: this could use some cleanup/stratification *)
      match Parser.peek p with
      | Lbrace -> (
        Parser.next p;
        let start_pos = Parser.start_pos p in
        match Parser.peek p with
        | DotDot | Dot ->
          let closed_flag =
            match Parser.peek p with
            | DotDot ->
              Parser.next p;
              Asttypes.Open
            | Dot ->
              Parser.next p;
              Asttypes.Closed
            | _ -> Asttypes.Closed
          in
          let fields =
            parse_comma_delimited_region
              ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace
              ~f:parse_string_field_declaration p
          in
          Parser.expect Rbrace p;
          let loc = mk_loc start_pos (Parser.position p) in
          let typ = Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag in
          Parser.optional p Comma |> ignore;
          let more_args =
            parse_comma_delimited_region ~grammar:Grammar.TypExprList
              ~closing:Rparen ~f:parse_typ_expr_region p
          in
          Parser.expect Rparen p;
          Parsetree.Pcstr_tuple (typ :: more_args)
        | DotDotDot -> (
          let dotdotdot_start = Parser.start_pos p in
          let dotdotdot_end = Parser.end_pos p in
          (* start of spread, e.g. `User({...a, "u": int})` *)
          Parser.next p;
          let spread_typ = parse_typ_expr p in
          match Parser.peek p with
          | Rbrace ->
            (* {...x}, spread without extra fields *)
            Parser.next p;
            let spread_field_name =
              Location.mkloc "..." (mk_loc dotdotdot_start dotdotdot_end)
            in
            let spread_field_loc =
              mk_loc start_pos spread_typ.ptyp_loc.loc_end
            in
            let spread_field =
              Ast_helper.Type.field ~attrs:[] ~loc:spread_field_loc
                ~mut:Asttypes.Immutable spread_field_name spread_typ
            in
            Parser.optional p Comma |> ignore;
            Parser.expect Rparen p;
            Parsetree.Pcstr_record [spread_field]
          | _ -> (
            let res =
              parse_spread_tail_classified ~start_pos ~spread_typ
                ~grammar:Grammar.FieldDeclarations p
            in
            match res with
            | `Record fields ->
              let spread_field_name =
                Location.mkloc "..." (mk_loc dotdotdot_start dotdotdot_end)
              in
              let spread_field_loc =
                mk_loc start_pos spread_typ.ptyp_loc.loc_end
              in
              let spread_field =
                Ast_helper.Type.field ~attrs:[] ~loc:spread_field_loc
                  ~mut:Asttypes.Immutable spread_field_name spread_typ
              in
              Parser.optional p Comma |> ignore;
              Parser.expect Rparen p;
              Parsetree.Pcstr_record (spread_field :: fields)
            | `Object typ ->
              Parser.optional p Comma |> ignore;
              let more_args =
                parse_comma_delimited_region ~grammar:Grammar.TypExprList
                  ~closing:Rparen ~f:parse_typ_expr_region p
              in
              Parser.expect Rparen p;
              Parsetree.Pcstr_tuple (typ :: more_args)))
        | _ -> (
          let attrs = parse_attributes p in
          match Parser.peek p with
          | String _ ->
            let closed_flag = Asttypes.Closed in
            let fields =
              match attrs with
              | [] ->
                parse_comma_delimited_region
                  ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace
                  ~f:parse_string_field_declaration p
              | attrs ->
                let first =
                  Parser.leave_breadcrumb p Grammar.StringFieldDeclarations;
                  let field =
                    match parse_string_field_declaration p with
                    | Some field -> field
                    | None -> assert false
                  in
                  (* parse comma after first *)
                  let () =
                    match Parser.peek p with
                    | Rbrace | Eof -> ()
                    | Comma -> Parser.next p
                    | _ -> Parser.expect Comma p
                  in
                  Parser.eat_breadcrumb p;
                  match field with
                  | Parsetree.Otag (label, _, ct) ->
                    Parsetree.Otag (label, attrs, ct)
                  | Oinherit ct -> Oinherit ct
                in
                first
                :: parse_comma_delimited_region
                     ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace
                     ~f:parse_string_field_declaration p
            in
            Parser.expect Rbrace p;
            let loc = mk_loc start_pos (Parser.position p) in
            let typ =
              Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag
              |> parse_type_alias p
            in
            let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in
            Parser.optional p Comma |> ignore;
            let more_args =
              parse_comma_delimited_region ~grammar:Grammar.TypExprList
                ~closing:Rparen ~f:parse_typ_expr_region p
            in
            Parser.expect Rparen p;
            Parsetree.Pcstr_tuple (typ :: more_args)
          | _ ->
            let fields =
              match attrs with
              | [] ->
                parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations
                  ~closing:Rbrace ~f:parse_field_declaration_region p
              | attrs ->
                let first = parse_field_declaration ~extra_attrs:attrs p in
                if Parser.peek p = Rbrace then [first]
                else (
                  Parser.expect Comma p;
                  first
                  :: parse_comma_delimited_region
                       ~grammar:Grammar.FieldDeclarations ~closing:Rbrace
                       ~f:parse_field_declaration_region p)
            in
            Parser.expect Rbrace p;
            Parser.optional p Comma |> ignore;
            Parser.expect Rparen p;
            Parsetree.Pcstr_record fields))
      | _ ->
        let args =
          parse_comma_delimited_region ~grammar:Grammar.TypExprList
            ~closing:Rparen ~f:parse_typ_expr_region p
        in
        Parser.expect Rparen p;
        Parsetree.Pcstr_tuple args)
    | _ -> Pcstr_tuple []
  in
  let res =
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      Some (parse_typ_expr p)
    | _ -> None
  in
  (constr_args, res)

(* Helper to check if current token is a bar or a run of doc comments followed
   by a bar *)
and is_bar_or_doc_comment_then_bar p =
  match Parser.peek p with
  | Bar -> true
  | DocComment _ ->
    Parser.lookahead p (fun state ->
        skip_doc_comments state;
        Parser.peek state = Bar)
  | _ -> false

(* The doc comments before the `|` of a constructor or tag. The printer puts
   every doc comment of a constructor on its own line before the `|`. *)
and parse_doc_comments p =
  match Parser.peek p with
  | DocComment (loc, s) ->
    Parser.next p;
    let doc_comment = doc_comment_to_attribute loc s in
    doc_comment :: parse_doc_comments p
  | _ -> []

(* constr-decl ::=
 *  | constr-name
 *  | attrs constr-name
 *  | constr-name const-args
 *  | attrs constr-name const-args *)
and parse_type_constructor_declaration_with_bar p =
  if is_bar_or_doc_comment_then_bar p then (
    let doc_comment_attrs = parse_doc_comments p in
    let start_pos = Parser.start_pos p in
    Parser.next p;
    let constr = parse_type_constructor_declaration ~start_pos p in
    Some
      {
        constr with
        Parsetree.pcd_attributes =
          doc_comment_attrs @ constr.Parsetree.pcd_attributes;
      })
  else None

and parse_type_constructor_declaration ~start_pos p =
  Parser.leave_breadcrumb p Grammar.ConstructorDeclaration;
  let attrs = parse_attributes p in
  match Parser.peek p with
  | DotDotDot ->
    Parser.next p;
    let name = Location.mkloc "..." (mk_loc start_pos (Parser.position p)) in
    let typ = parse_poly_type_expr p in
    let loc = mk_loc start_pos typ.ptyp_loc.loc_end in
    Ast_helper.Type.constructor ~loc ~attrs ~args:(Pcstr_tuple [typ]) name
  | Uident uident ->
    let uident_loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
    Parser.next p;
    let args, res = parse_constr_decl_args p in
    Parser.eat_breadcrumb p;
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Type.constructor ~loc ~attrs ?res ~args
      (Location.mkloc uident uident_loc)
  | t ->
    Parser.err p (Diagnostics.uident t);
    Ast_helper.Type.constructor (Location.mknoloc "_")

(* [|] constr-decl  { | constr-decl }   *)
and parse_type_constructor_declarations ?first p =
  let first_constr_decl =
    match first with
    | None ->
      let doc_comment_attrs = parse_doc_comments p in
      let start_pos = Parser.start_pos p in
      ignore (Parser.optional p Token.Bar);
      let constr = parse_type_constructor_declaration ~start_pos p in
      {constr with pcd_attributes = doc_comment_attrs @ constr.pcd_attributes}
    | Some first_constr_decl -> first_constr_decl
  in
  first_constr_decl
  :: parse_region ~grammar:Grammar.ConstructorDeclaration
       ~f:parse_type_constructor_declaration_with_bar p

(*
 * type-representation ::=
 *  ∣	 = [ | ] constr-decl  { | constr-decl }
 *  ∣	 = private [ | ] constr-decl  { | constr-decl }
 *  |  = |
 *  ∣	 = private |
 *  ∣	 = record-decl
 *  ∣	 = private record-decl
 *  |  = ..
 *)
and parse_type_representation ?current_type_name_path ?inline_types_context p =
  Parser.leave_breadcrumb p Grammar.TypeRepresentation;
  (* = consumed *)
  let private_flag =
    if Parser.optional p Token.Private then Asttypes.Private
    else Asttypes.Public
  in
  let kind, attrs =
    match Parser.peek p with
    | Bar | Uident _ ->
      (Parsetree.Ptype_variant (parse_type_constructor_declarations p), [])
    | At | DocComment _ -> (
      (* Attributes and doc comments can prefix either a variant (constructor
         list), a record, or an open/extensible variant marker (`..`). Peek past
         them to decide which kind it is. *)
      let after_attrs =
        Parser.lookahead p (fun state ->
            ignore (parse_attributes state);
            skip_doc_comments state;
            Parser.peek state)
      in
      match after_attrs with
      | Lbrace ->
        (* Attributes (and doc comments) before a record have no node of their
           own: they are returned so the caller attaches them to the type
           declaration. *)
        let attrs = parse_attributes p in
        ( Parsetree.Ptype_record
            (parse_record_declaration ?current_type_name_path
               ?inline_types_context p),
          attrs )
      | DotDot ->
        (* Same for attributes before an open variant marker `..`. *)
        let attrs = parse_attributes p in
        Parser.next p;
        (* consume DotDot *)
        (Ptype_open, attrs)
      | _ ->
        (* fall back to variant constructor declarations; leave attributes for the
             constructor parsing so they attach to the first constructor. *)
        (Parsetree.Ptype_variant (parse_type_constructor_declarations p), []))
    | Lbrace ->
      ( Parsetree.Ptype_record
          (parse_record_declaration ?current_type_name_path
             ?inline_types_context p),
        [] )
    | DotDot ->
      Parser.next p;
      (Ptype_open, [])
    | token ->
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      (* TODO: I have no idea if this is even remotely a good idea *)
      (Parsetree.Ptype_variant [], [])
  in
  Parser.eat_breadcrumb p;
  (private_flag, kind, attrs)

(* type-param	::=
 *  | variance 'lident
 *  | variance 'uident
 *  | variance _
 *
 * variance ::=
 *   | +
 *   | -
 *   | (* empty *)
 *)
and parse_type_param p =
  let variance =
    match Parser.peek p with
    | Plus ->
      Parser.next p;
      Asttypes.Covariant
    | Minus ->
      Parser.next p;
      Contravariant
    | _ -> Invariant
  in
  match Parser.peek p with
  | SingleQuote ->
    Parser.next p;
    let ident, loc =
      if Parser.peek p = Eof then (
        Parser.err ~start_pos:(Parser.start_pos p) p
          (Diagnostics.unexpected (Parser.peek p) p.breadcrumbs);
        ("", mk_loc (Parser.start_pos p) (Parser.position p)))
      else
        parse_ident ~msg:Error_messages.type_param
          ~start_pos:(Parser.start_pos p) p
    in
    Some (Ast_helper.Typ.var ~loc ident, variance)
  | Underscore ->
    let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
    Parser.next p;
    Some (Ast_helper.Typ.any ~loc (), variance)
  | (Uident _ | Lident _) as token ->
    Parser.err p
      (Diagnostics.message
         ("Type params start with a singlequote: '" ^ Token.to_string token));
    let ident, loc =
      parse_ident ~msg:Error_messages.type_param ~start_pos:(Parser.start_pos p)
        p
    in
    Some (Ast_helper.Typ.var ~loc ident, variance)
  | _token -> None

(* type-params	::=
 *  | <type-param>
 *  ∣	<type-param, type-param>
 *  ∣	<type-param, type-param, type-param>
 *  ∣	<type-param, type-param, type-param,>
 *
 *  TODO: when we have pretty-printer show an error
 *  with the actual code corrected. *)
and parse_type_params ~parent p =
  let opening = Parser.peek p in
  match opening with
  | (LessThan | Lparen)
    when (Parser.start_pos p).pos_lnum == (Parser.position p).pos_lnum ->
    let opening_start_pos = Parser.start_pos p in
    Parser.leave_breadcrumb p Grammar.TypeParams;
    Parser.next p;
    let params =
      parse_comma_delimited_region ~grammar:Grammar.TypeParams
        ~closing:GreaterThan ~f:parse_type_param p
    in
    let () =
      match Parser.peek p with
      | Rparen when opening = Token.Lparen ->
        let msg =
          Doc.breakable_group ~force_break:true
            (Doc.concat
               [
                 Doc.text "Type parameters require angle brackets:";
                 Doc.indent
                   (Doc.concat
                      [
                        Doc.line;
                        Doc.concat
                          [
                            Res_printer.print_longident parent.Location.txt;
                            Res_printer.print_type_params params
                              Comment_table.empty;
                          ];
                      ]);
               ])
          |> Doc.to_string ~width:80
        in
        Parser.err ~start_pos:opening_start_pos p (Diagnostics.message msg);
        Parser.next p
      | _ -> Parser.expect GreaterThan p
    in
    Parser.eat_breadcrumb p;
    params
  | _ -> []

(* type-constraint	::=	constraint ' ident =  typexpr *)
and parse_type_constraint p =
  let start_pos = Parser.start_pos p in
  match Parser.peek p with
  | Token.Constraint -> (
    Parser.next p;
    Parser.expect SingleQuote p;
    match Parser.peek p with
    | Lident ident | Uident ident ->
      let ident_loc = mk_loc start_pos (Parser.end_pos p) in
      Parser.next p;
      Parser.expect Equal p;
      let typ = parse_typ_expr p in
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Typ.var ~loc:ident_loc ident, typ, loc)
    | t ->
      Parser.err p (Diagnostics.lident t);
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Typ.any (), parse_typ_expr p, loc))
  | _ -> None

(* type-constraints ::=
 *  | (* empty *)
 *  | type-constraint
 *  | type-constraint type-constraint
 *  | type-constraint type-constraint type-constraint (* 0 or more *)
 *)
and parse_type_constraints p =
  parse_region ~grammar:Grammar.TypeConstraint ~f:parse_type_constraint p

and parse_type_equation_or_constr_decl p =
  let uident_start_pos = Parser.start_pos p in
  match Parser.peek p with
  | Uident uident -> (
    Parser.next p;
    match Parser.peek p with
    | Dot -> (
      Parser.next p;
      let type_constr =
        parse_value_path_tail p uident_start_pos (Longident.Lident uident)
      in
      let loc = mk_loc uident_start_pos (Parser.position p) in
      let typ =
        parse_type_alias p
          (Ast_helper.Typ.constr ~loc type_constr
             (parse_type_constructor_args ~constr_name:type_constr p))
      in
      match Parser.peek p with
      | Equal ->
        Parser.next p;
        let priv, kind, attrs = parse_type_representation p in
        (Some typ, priv, kind, attrs)
      | EqualGreater ->
        Parser.next p;
        let return_type = parse_typ_expr ~alias:false p in
        let loc = mk_loc uident_start_pos (Parser.position p) in
        let arrow_type =
          Ast_helper.Typ.arrow ~loc
            [Parg_type {attrs = []; lbl = Nolabel; typ}]
            return_type
        in
        let typ = parse_type_alias p arrow_type in
        (Some typ, Asttypes.Public, Parsetree.Ptype_abstract, [])
      | _ -> (Some typ, Asttypes.Public, Parsetree.Ptype_abstract, []))
    | _ ->
      let uident_end_pos = Parser.position p in
      let args, res = parse_constr_decl_args p in
      let first =
        Some
          (let uident_loc = mk_loc uident_start_pos uident_end_pos in
           Ast_helper.Type.constructor
             ~loc:(mk_loc uident_start_pos (Parser.position p))
             ?res ~args
             (Location.mkloc uident uident_loc))
      in
      ( None,
        Asttypes.Public,
        Parsetree.Ptype_variant (parse_type_constructor_declarations p ?first),
        [] ))
  | t ->
    Parser.err p (Diagnostics.uident t);
    (* TODO: is this a good idea? *)
    (None, Asttypes.Public, Parsetree.Ptype_abstract, [])

and parse_spread_tail_classified ~start_pos ~spread_typ ~grammar p =
  match Parser.peek p with
  | Rbrace ->
    (* `{...t}` no extra fields: treat as record without tail fields *)
    Parser.next p;
    `Record []
  | _ ->
    Parser.expect Comma p;
    let found_object_field = ref false in
    let (fields : Parsetree.label_declaration list) =
      parse_comma_delimited_region ~grammar ~closing:Rbrace
        ~f:(parse_field_declaration_region ~found_object_field)
        p
    in
    Parser.expect Rbrace p;
    if !found_object_field then
      (* Object-style: build an object type that inherits the spread *)
      let obj_fields =
        let convert (ld : Parsetree.label_declaration) =
          let ({Parsetree.pld_name; pld_type; _} : Parsetree.label_declaration)
              =
            ld
          in
          match pld_name.txt with
          | "..." -> Parsetree.Oinherit pld_type
          | _ -> Otag (pld_name, Ast_helper.Type.field_attributes ld, pld_type)
        in
        Parsetree.Oinherit spread_typ :: List.map convert fields
      in
      let loc = mk_loc start_pos (Parser.position p) in
      let typ =
        Ast_helper.Typ.object_ ~loc obj_fields Asttypes.Closed
        |> parse_type_alias p
      in
      let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in
      `Object typ
    else `Record fields

and parse_record_or_object_decl ?current_type_name_path ?inline_types_context p
    =
  let start_pos = Parser.start_pos p in
  Parser.expect Lbrace p;
  match Parser.peek p with
  | DotDot | Dot ->
    let closed_flag =
      match Parser.peek p with
      | DotDot ->
        Parser.next p;
        Asttypes.Open
      | Dot ->
        Parser.next p;
        Asttypes.Closed
      | _ -> Asttypes.Closed
    in
    let fields =
      parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations
        ~closing:Rbrace ~f:parse_string_field_declaration p
    in
    Parser.expect Rbrace p;
    let loc = mk_loc start_pos (Parser.position p) in
    let typ =
      Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag
      |> parse_type_alias p
    in
    let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in
    (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)
  | DotDotDot -> (
    let dotdotdot_start = Parser.start_pos p in
    let dotdotdot_end = Parser.end_pos p in
    (* start of object type spreading, e.g. `type u = {...a, "u": int}` *)
    Parser.next p;
    let typ = parse_typ_expr p in
    match Parser.peek p with
    | Rbrace ->
      (* {...x}, spread without extra fields *)
      Parser.next p;
      let loc = mk_loc start_pos (Parser.position p) in
      let dot_field =
        Ast_helper.Type.field ~loc
          {txt = "..."; loc = mk_loc dotdotdot_start dotdotdot_end}
          typ
      in
      let kind = Parsetree.Ptype_record [dot_field] in
      (None, Public, kind)
    | _ ->
      Parser.expect Comma p;
      let loc = mk_loc start_pos (Parser.position p) in
      let dot_field =
        Ast_helper.Type.field ~loc
          {txt = "..."; loc = mk_loc dotdotdot_start dotdotdot_end}
          typ
      in
      let found_object_field = ref false in
      let fields =
        parse_comma_delimited_region ~grammar:Grammar.RecordDecl ~closing:Rbrace
          ~f:
            (parse_field_declaration_region ?current_type_name_path
               ?inline_types_context ~found_object_field)
          p
      in
      Parser.expect Rbrace p;
      if !found_object_field then
        let fields =
          Ext_list.map fields (fun ld ->
              match ld.pld_name.txt with
              | "..." -> Parsetree.Oinherit ld.pld_type
              | _ ->
                Otag
                  (ld.pld_name, Ast_helper.Type.field_attributes ld, ld.pld_type))
        in
        let dot_field = Parsetree.Oinherit typ in
        let typ_obj = Ast_helper.Typ.object_ (dot_field :: fields) Closed in
        let typ_obj = parse_type_alias p typ_obj in
        let typ_obj =
          parse_arrow_type_rest ~es6_arrow:true ~start_pos typ_obj p
        in
        (Some typ_obj, Public, Ptype_abstract)
      else
        let kind = Parsetree.Ptype_record (dot_field :: fields) in
        (None, Public, kind))
  | _ -> (
    let attrs = parse_attributes p in
    match Parser.peek p with
    | String _ ->
      let closed_flag = Asttypes.Closed in
      let fields =
        match attrs with
        | [] ->
          parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations
            ~closing:Rbrace ~f:parse_string_field_declaration p
        | attrs ->
          let first =
            Parser.leave_breadcrumb p Grammar.StringFieldDeclarations;
            let field =
              match parse_string_field_declaration p with
              | Some field -> field
              | None -> assert false
            in
            (* parse comma after first *)
            let () =
              match Parser.peek p with
              | Rbrace | Eof -> ()
              | Comma -> Parser.next p
              | _ -> Parser.expect Comma p
            in
            Parser.eat_breadcrumb p;
            match field with
            | Parsetree.Otag (label, _, ct) -> Parsetree.Otag (label, attrs, ct)
            | Oinherit ct -> Oinherit ct
          in
          first
          :: parse_comma_delimited_region
               ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace
               ~f:parse_string_field_declaration p
      in
      Parser.expect Rbrace p;
      let loc = mk_loc start_pos (Parser.position p) in
      let typ =
        Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag
        |> parse_type_alias p
      in
      let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in
      (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)
    | _ ->
      Parser.leave_breadcrumb p Grammar.RecordDecl;
      let fields =
        (* XXX *)
        match attrs with
        | [] ->
          parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations
            ~closing:Rbrace
            ~f:
              (parse_field_declaration_region ?current_type_name_path
                 ?inline_types_context)
            p
        | attr :: _ as attrs ->
          let first =
            let field =
              parse_field_declaration ?current_type_name_path
                ?inline_types_context ~extra_attrs:attrs p
            in
            Parser.optional p Comma |> ignore;
            {
              field with
              Parsetree.pld_loc =
                {field.pld_loc with loc_start = (attr |> fst).loc.loc_start};
            }
          in
          first
          :: parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations
               ~closing:Rbrace
               ~f:
                 (parse_field_declaration_region ?current_type_name_path
                    ?inline_types_context)
               p
      in
      Parser.expect Rbrace p;
      Parser.eat_breadcrumb p;
      (None, Asttypes.Public, Parsetree.Ptype_record fields))

and parse_private_eq_or_repr p =
  Parser.expect Private p;
  match Parser.peek p with
  | Lbrace ->
    let manifest, _, kind = parse_record_or_object_decl p in
    (manifest, Asttypes.Private, kind, [])
  | Uident _ ->
    let manifest, _, kind, attrs = parse_type_equation_or_constr_decl p in
    (manifest, Asttypes.Private, kind, attrs)
  | Bar | DotDot ->
    let _, kind, attrs = parse_type_representation p in
    (None, Asttypes.Private, kind, attrs)
  | (At | DocComment _) when is_representation_after_attrs p ->
    let _, kind, attrs = parse_type_representation p in
    (None, Asttypes.Private, kind, attrs)
  | DocComment _ ->
    (Some (parse_typ_expr p), Asttypes.Private, Parsetree.Ptype_abstract, [])
  | t when Grammar.is_typ_expr_start t ->
    (Some (parse_typ_expr p), Asttypes.Private, Parsetree.Ptype_abstract, [])
  | _ ->
    let _, kind, attrs = parse_type_representation p in
    (None, Asttypes.Private, kind, attrs)

(*
  polymorphic-variant-type	::=
                            | [ tag-spec-first  { | tag-spec } ]
                            | [> [ tag-spec ]  { | tag-spec } ]
                            | [< [|] tag-spec-full  { | tag-spec-full }  [ > { `tag-name }+ ] ]

            tag-spec-first	::=	`tag-name  [ of typexpr ]
                            |	[ typexpr ] |  tag-spec

                  tag-spec	::=	`tag-name  [ of typexpr ]
                            |	typexpr

              tag-spec-full	::=	`tag-name  [ of [&] typexpr  { & typexpr } ]
                             |	typexpr
*)
and parse_polymorphic_variant_type ~attrs p =
  let start_pos = Parser.start_pos p in
  Parser.expect Lbracket p;
  match Parser.peek p with
  | GreaterThan ->
    Parser.next p;
    let row_fields =
      match Parser.peek p with
      | Rbracket -> []
      | Bar -> parse_tag_specs p
      | _ ->
        let row_field = parse_tag_spec p in
        row_field :: parse_tag_specs p
    in
    let variant =
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Typ.variant ~attrs ~loc row_fields Open None
    in
    Parser.expect Rbracket p;
    variant
  | LessThan ->
    Parser.next p;
    Parser.optional p Bar |> ignore;
    let row_field = parse_tag_spec_full p in
    let row_fields = parse_tag_spec_fulls p in
    let tag_names = parse_tag_names p in
    let variant =
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Typ.variant ~attrs ~loc (row_field :: row_fields) Closed
        (Some tag_names)
    in
    Parser.expect Rbracket p;
    variant
  | _ ->
    let row_fields1 = parse_tag_spec_first p in
    let row_fields2 = parse_tag_specs p in
    let variant =
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Typ.variant ~attrs ~loc (row_fields1 @ row_fields2) Closed None
    in
    Parser.expect Rbracket p;
    variant

and parse_tag_name p =
  match Parser.peek p with
  | Hash ->
    let ident, _loc = parse_hash_ident ~start_pos:(Parser.start_pos p) p in
    Some ident
  | _ -> None

and parse_tag_names p =
  if Parser.peek p == GreaterThan then (
    Parser.next p;
    parse_region p ~grammar:Grammar.TagNames ~f:parse_tag_name)
  else []

and parse_tag_spec_fulls p =
  match Parser.peek p with
  | Rbracket -> []
  | GreaterThan -> []
  | Bar ->
    Parser.next p;
    let row_field = parse_tag_spec_full p in
    row_field :: parse_tag_spec_fulls p
  | _ -> []

and parse_tag_spec_full p =
  let attrs = parse_attributes p in
  match Parser.peek p with
  | Hash -> parse_polymorphic_variant_type_spec_hash ~attrs ~full:true p
  | _ ->
    let typ = parse_typ_expr ~attrs p in
    Parsetree.Rinherit typ

and parse_tag_specs p =
  match Parser.peek p with
  | (Bar | DocComment _) when is_bar_or_doc_comment_then_bar p ->
    let doc_comment_attrs = parse_doc_comments p in
    Parser.expect Bar p;
    let tag = parse_tag_spec p in
    let tag_with_doc =
      match tag with
      | Parsetree.Rtag (name, attrs, contains_constant, types) ->
        Parsetree.Rtag
          (name, doc_comment_attrs @ attrs, contains_constant, types)
      | Rinherit typ ->
        Rinherit
          {typ with ptyp_attributes = doc_comment_attrs @ typ.ptyp_attributes}
    in
    tag_with_doc :: parse_tag_specs p
  | _ -> []

and parse_tag_spec p =
  let doc_comment_attrs =
    match Parser.peek p with
    | DocComment (loc, s) ->
      Parser.next p;
      [doc_comment_to_attribute loc s]
    | _ -> []
  in
  let attrs = doc_comment_attrs @ parse_attributes p in
  match Parser.peek p with
  | Hash -> parse_polymorphic_variant_type_spec_hash ~attrs ~full:false p
  | _ ->
    let typ = parse_typ_expr ~attrs p in
    Parsetree.Rinherit typ

and parse_tag_spec_first p =
  match Parser.peek p with
  | (Bar | DocComment _) when is_bar_or_doc_comment_then_bar p ->
    let doc_comment_attrs = parse_doc_comments p in
    Parser.expect Bar p;
    let tag = parse_tag_spec p in
    (match tag with
    | Parsetree.Rtag (name, attrs, contains_constant, types) ->
      Parsetree.Rtag (name, doc_comment_attrs @ attrs, contains_constant, types)
    | Rinherit typ ->
      Rinherit
        {typ with ptyp_attributes = doc_comment_attrs @ typ.ptyp_attributes})
    :: parse_tag_specs p
  | DocComment _ | Hash | At -> (
    let doc_comment_attrs =
      match Parser.peek p with
      | DocComment (loc, s) ->
        Parser.next p;
        [doc_comment_to_attribute loc s]
      | _ -> []
    in
    let attrs = doc_comment_attrs @ parse_attributes p in
    match Parser.peek p with
    | Hash -> [parse_polymorphic_variant_type_spec_hash ~attrs ~full:false p]
    | _ -> (
      let typ = parse_typ_expr ~attrs p in
      match Parser.peek p with
      | Rbracket ->
        (* example: [ListStyleType.t] *)
        [Parsetree.Rinherit typ]
      | _ ->
        Parser.expect Bar p;
        [Parsetree.Rinherit typ; parse_tag_spec p]))
  | _ -> (
    let typ = parse_typ_expr p in
    match Parser.peek p with
    | Rbracket ->
      (* example: [ListStyleType.t] *)
      [Parsetree.Rinherit typ]
    | _ ->
      Parser.expect Bar p;
      [Parsetree.Rinherit typ; parse_tag_spec p])

and parse_polymorphic_variant_type_spec_hash ~attrs ~full p :
    Parsetree.row_field =
  let start_pos = Parser.start_pos p in
  let ident, loc = parse_hash_ident ~start_pos p in
  let rec loop p =
    match Parser.peek p with
    | Ampersand when full ->
      Parser.next p;
      let row_field = parse_polymorphic_variant_type_args p in
      row_field :: loop p
    | _ -> []
  in
  let first_tuple, tag_contains_a_constant_empty_constructor =
    match Parser.peek p with
    | Ampersand when full ->
      Parser.next p;
      ([parse_polymorphic_variant_type_args p], true)
    | Lparen -> ([parse_polymorphic_variant_type_args p], false)
    | _ -> ([], true)
  in
  let tuples = first_tuple @ loop p in
  Parsetree.Rtag
    ( Location.mkloc ident loc,
      attrs,
      tag_contains_a_constant_empty_constructor,
      tuples )

and parse_polymorphic_variant_type_args p =
  let start_pos = Parser.start_pos p in
  Parser.expect Lparen p;
  let args =
    parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen
      ~f:parse_typ_expr_region p
  in
  Parser.expect Rparen p;
  Location.mkloc args (mk_loc start_pos (Parser.position p))

(* Attributes and doc comments after `=` (or `= private`) can start a
   representation (variant/record/open variant) or a manifest. Look ahead past
   them: if a representation-like token follows, it is a representation;
   otherwise a manifest type expression. *)
and is_representation_after_attrs p =
  let starts_with_doc_comment =
    match Parser.peek p with
    | DocComment _ -> true
    | _ -> false
  in
  Parser.lookahead p (fun state ->
      ignore (parse_attributes state);
      (* optionally skip a run of doc comments before deciding *)
      skip_doc_comments state;
      match Parser.peek state with
      | Lbrace -> (
        (* Disambiguate record declaration vs object type.
           Peek inside the braces; if it looks like an object (String/Dot/DotDot/DotDotDot),
           then this is a manifest type expression, not a representation. If it looks like
           a record field (e.g. Lident or attributes before one), treat as representation. *)
        Parser.next state;
        (* consume Lbrace *)
        ignore (parse_attributes state);
        skip_doc_comments state;
        match Parser.peek state with
        | String _ | Dot | DotDot -> false (* object type => manifest *)
        | DotDotDot ->
          (* A spread (`{...base, y: int}`) after a leading doc comment has
             always been parsed as a record declaration, and after a leading
             attribute as an object type. *)
          starts_with_doc_comment
        | _ -> true
        (* record decl => representation *))
      | Bar -> true (* variant constructor list *)
      | DotDot -> true (* extensible/open variant ".." *)
      | DotDotDot ->
        (* A variant spread (`...base | C`) after a leading doc comment has
           always been parsed as a constructor list. *)
        starts_with_doc_comment
      | Uident _ -> (
        (* constructor vs module-qualified manifest *)
        Parser.next state;
        match Parser.peek state with
        | Dot -> false (* M.t => manifest *)
        | _ -> true
        (* Uident starting a constructor *))
      | DocComment _ -> true (* doc before constructor list *)
      | _ -> false)

and parse_type_equation_and_representation ?current_type_name_path
    ?inline_types_context p =
  match Parser.peek p with
  | (Equal | Bar) as token -> (
    if token = Bar then Parser.expect Equal p;
    Parser.next p;
    match Parser.peek p with
    | Uident _ -> parse_type_equation_or_constr_decl p
    | Lbrace ->
      let manifest, priv, kind =
        parse_record_or_object_decl ?current_type_name_path
          ?inline_types_context p
      in
      (manifest, priv, kind, [])
    | Private -> parse_private_eq_or_repr p
    | Bar | DotDot ->
      let priv, kind, attrs =
        parse_type_representation ?current_type_name_path ?inline_types_context
          p
      in
      (None, priv, kind, attrs)
    | At | DocComment _ -> (
      if is_representation_after_attrs p then
        let priv, kind, attrs =
          parse_type_representation ?current_type_name_path
            ?inline_types_context p
        in
        (None, priv, kind, attrs)
      else
        let manifest = Some (parse_typ_expr p) in
        match Parser.peek p with
        | Equal ->
          Parser.next p;
          let priv, kind, attrs =
            parse_type_representation ?current_type_name_path
              ?inline_types_context p
          in
          (manifest, priv, kind, attrs)
        | _ -> (manifest, Public, Parsetree.Ptype_abstract, []))
    | _ -> (
      let manifest = Some (parse_typ_expr p) in
      match Parser.peek p with
      | Equal ->
        Parser.next p;
        let priv, kind, attrs =
          parse_type_representation ?current_type_name_path
            ?inline_types_context p
        in
        (manifest, priv, kind, attrs)
      | _ -> (manifest, Public, Parsetree.Ptype_abstract, [])))
  | _ -> (None, Public, Parsetree.Ptype_abstract, [])

(* type-definition	::=	type [rec] typedef  { and typedef }
 * typedef	::=	typeconstr-name [type-params] type-information
 * type-information	::=	[type-equation]  [type-representation]  { type-constraint }
 * type-equation	::=	= typexpr *)
and parse_type_def ~attrs ~start_pos p =
  Parser.leave_breadcrumb p Grammar.TypeDef;
  Parser.leave_breadcrumb p Grammar.TypeConstrName;
  let name, loc = parse_lident p in
  let type_constr_name = Location.mkloc name loc in
  Parser.eat_breadcrumb p;
  let params =
    let constr_name = Location.mkloc (Longident.Lident name) loc in
    parse_type_params ~parent:constr_name p
  in
  let type_def =
    let manifest, priv, kind, repr_attrs =
      parse_type_equation_and_representation p
    in
    let cstrs = parse_type_constraints p in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Type.mk ~loc ~attrs:(attrs @ repr_attrs) ~priv ~kind ~params
      ~cstrs ?manifest type_constr_name
  in
  Parser.eat_breadcrumb p;
  type_def

and parse_type_extension ~params ~attrs ~name p =
  Parser.expect PlusEqual p;
  let priv =
    if Parser.optional p Token.Private then Asttypes.Private
    else Asttypes.Public
  in
  let constr_start = Parser.start_pos p in
  Parser.optional p Bar |> ignore;
  let first =
    let attrs, name, kind =
      match Parser.peek p with
      | Bar ->
        Parser.next p;
        parse_constr_def ~parse_attrs:true p
      | _ -> parse_constr_def ~parse_attrs:true p
    in
    let loc = mk_loc constr_start (Parser.position p) in
    Ast_helper.Te.constructor ~loc ~attrs name kind
  in
  let rec loop p cs =
    match Parser.peek p with
    | Bar ->
      let start_pos = Parser.start_pos p in
      Parser.next p;
      let attrs, name, kind = parse_constr_def ~parse_attrs:true p in
      let ext_constr =
        Ast_helper.Te.constructor ~attrs
          ~loc:(mk_loc start_pos (Parser.position p))
          name kind
      in
      loop p (ext_constr :: cs)
    | _ -> List.rev cs
  in
  let constructors = loop p [first] in
  Ast_helper.Te.mk ~attrs ~params ~priv name constructors

and parse_type_definitions ~current_type_name_path ~inline_types_context ~attrs
    ~name ~params ~start_pos p =
  let type_def =
    let manifest, priv, kind, repr_attrs =
      parse_type_equation_and_representation ~current_type_name_path
        ~inline_types_context p
    in
    let cstrs = parse_type_constraints p in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Type.mk ~loc ~attrs:(attrs @ repr_attrs) ~priv ~kind ~params
      ~cstrs ?manifest
      {name with txt = lident_of_path name.Location.txt}
  in
  let rec loop p defs =
    let start_pos = Parser.start_pos p in
    let attrs = parse_attributes_and_binding p in
    match Parser.peek p with
    | And ->
      Parser.next p;
      let type_def = parse_type_def ~attrs ~start_pos p in
      loop p (type_def :: defs)
    | _ -> List.rev defs
  in
  loop p [type_def]

(* TODO: decide if we really want type extensions (eg. type x += Blue)
 * It adds quite a bit of complexity that can be avoided,
 * implemented for now. Needed to get a feel for the complexities of
 * this territory of the grammar *)
and parse_type_definition_or_extension ~attrs p =
  let start_pos = Parser.start_pos p in
  Parser.expect Token.Typ p;
  let rec_flag =
    match Parser.peek p with
    | Rec ->
      Parser.next p;
      Asttypes.Recursive
    | Lident "nonrec" ->
      Parser.next p;
      Asttypes.Nonrecursive
    | _ -> Asttypes.Nonrecursive
  in
  let name = parse_value_path p in
  let params = parse_type_params ~parent:name p in
  match Parser.peek p with
  | PlusEqual -> TypeExt (parse_type_extension ~params ~attrs ~name p)
  | _ ->
    (* shape of type name should be Lident, i.e. `t` is accepted. `User.t` not *)
    let () =
      match name.Location.txt with
      | Lident _ -> ()
      | longident ->
        Parser.err ~start_pos:name.loc.loc_start ~end_pos:name.loc.loc_end p
          (longident |> Error_messages.type_declaration_name_longident
         |> Diagnostics.message)
    in
    let current_type_name_path = Longident.flatten name.txt in
    let inline_types_context =
      {found_inline_types = []; params; collect_free_type_vars = false}
    in
    let type_defs =
      parse_type_definitions ~inline_types_context ~current_type_name_path
        ~attrs ~name ~params ~start_pos p
    in
    let rec_flag =
      if List.length inline_types_context.found_inline_types > 0 then
        Asttypes.Recursive
      else rec_flag
    in
    let inline_types =
      inline_types_context.found_inline_types
      |> List.map (fun inline_type ->
          Ast_helper.Type.mk ~params:inline_type.params
            ~origin:Inline_record_definition ~loc:inline_type.loc
            ~kind:inline_type.kind
            {name with txt = inline_type.name})
    in
    TypeDef {rec_flag; types = inline_types @ type_defs}

(* external value-name : typexp = external-declaration *)
and parse_external_def ~attrs ~start_pos p =
  Parser.leave_breadcrumb p Grammar.External;
  Fun.protect
    ~finally:(fun () -> Parser.eat_breadcrumb p)
    (fun () ->
      Parser.expect Token.External p;
      let name, loc = parse_lident p in
      let name = Location.mkloc name loc in
      Parser.expect ~grammar:Grammar.TypeExpression Colon p;
      let current_type_name_path = Some [name.txt] in
      let inline_types_context =
        {found_inline_types = []; params = []; collect_free_type_vars = true}
      in
      let typ_expr =
        parse_external_type_expr ~current_type_name_path ~inline_types_context p
        |> Ast_fixed_arg.normalize_external_type
      in
      let equal_start = Parser.start_pos p in
      let equal_end = Parser.end_pos p in
      Parser.expect Equal p;
      let prim =
        match Parser.peek p with
        | String s ->
          Parser.next p;
          Some (Parsetree.Prim_name s)
        | _ ->
          Parser.err ~start_pos:equal_start ~end_pos:equal_end p
            (Diagnostics.message
               ("An external requires the name of the JS value you're \
                 referring to, like \"" ^ name.txt ^ "\"."));
          None
      in
      let loc = mk_loc start_pos (Parser.position p) in
      let vb = Ast_helper.Val.mk ~loc ~attrs ?prim name typ_expr in
      let inline_types =
        inline_types_context.found_inline_types
        |> List.rev_map (fun inline_type ->
            Ast_helper.Type.mk ~params:inline_type.params
              ~origin:Inline_record_definition ~loc:inline_type.loc
              ~kind:inline_type.kind
              {name with txt = inline_type.name})
        |> List.rev
      in
      (vb, inline_types))

(* constr-def ::=
 *  | constr-decl
 *  | constr-name = constr
 *
 *  constr-decl ::= constr-name constr-args
 *  constr-name ::= uident
 *  constr      ::= path-uident *)
and parse_constr_def ~parse_attrs p =
  let attrs = if parse_attrs then parse_attributes p else [] in
  let name =
    match Parser.peek p with
    | Uident name ->
      let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      Location.mkloc name loc
    | t ->
      Parser.err p (Diagnostics.uident t);
      Location.mknoloc "_"
  in
  let kind =
    match Parser.peek p with
    | Lparen ->
      let args, res = parse_constr_decl_args p in
      Parsetree.Pext_decl (args, res)
    | Equal ->
      Parser.next p;
      let longident = parse_module_long_ident ~lowercase:false p in
      Parsetree.Pext_rebind longident
    | Colon ->
      Parser.next p;
      let typ = parse_typ_expr p in
      Parsetree.Pext_decl (Pcstr_tuple [], Some typ)
    | _ -> Parsetree.Pext_decl (Pcstr_tuple [], None)
  in
  (attrs, name, kind)

(*
 * exception-definition	::=
 *  | exception constr-decl
 *  ∣	exception constr-name = constr
 *
 *  constr-name ::= uident
 *  constr ::= long_uident *)
and parse_exception_def ~attrs p =
  let start_pos = Parser.start_pos p in
  Parser.expect Token.Exception p;
  let _, name, kind = parse_constr_def ~parse_attrs:false p in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Te.constructor ~loc ~attrs name kind

and parse_newline_or_semicolon_structure p =
  match Parser.peek p with
  | Semicolon -> Parser.next p
  | token when Grammar.is_structure_item_start token ->
    if (Parser.position p).pos_lnum < (Parser.start_pos p).pos_lnum then ()
    else
      Parser.err ~start_pos:(Parser.position p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message
           "Consecutive statements on a line must be separated by ';' or a \
            newline")
  | _ -> ()

and parse_structure_item_region pending_structure_items p =
  let start_pos = Parser.start_pos p in
  match !pending_structure_items with
  | item :: rest ->
    pending_structure_items := rest;
    Some item
  | [] -> (
    let attrs = parse_attributes p in
    match Parser.peek p with
    | Open ->
      let open_description = parse_open_description ~attrs p in
      parse_newline_or_semicolon_structure p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Str.open_ ~loc open_description)
    | Let {unwrap} ->
      let rec_flag, let_bindings =
        parse_let_bindings ~unwrap ~attrs ~start_pos p
      in
      parse_newline_or_semicolon_structure p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Str.value ~loc rec_flag let_bindings)
    | Typ -> (
      Parser.begin_region p;
      match parse_type_definition_or_extension ~attrs p with
      | TypeDef {rec_flag; types} ->
        parse_newline_or_semicolon_structure p;
        let loc = mk_loc start_pos (Parser.position p) in
        Parser.end_region p;
        Some (Ast_helper.Str.type_ ~loc rec_flag types)
      | TypeExt ext ->
        parse_newline_or_semicolon_structure p;
        let loc = mk_loc start_pos (Parser.position p) in
        Parser.end_region p;
        Some (Ast_helper.Str.type_extension ~loc ext))
    | External -> (
      let external_def, inline_types = parse_external_def ~attrs ~start_pos p in
      parse_newline_or_semicolon_structure p;
      let loc = mk_loc start_pos (Parser.position p) in
      match inline_types with
      | [] -> Some (Ast_helper.Str.primitive ~loc external_def)
      | _ ->
        let type_item =
          Ast_helper.Str.type_ ~loc Asttypes.Recursive inline_types
        in
        let primitive_item = Ast_helper.Str.primitive ~loc external_def in
        pending_structure_items := primitive_item :: !pending_structure_items;
        Some type_item)
    | Exception ->
      let exception_def = parse_exception_def ~attrs p in
      parse_newline_or_semicolon_structure p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Str.exception_ ~loc exception_def)
    | Include ->
      let include_statement = parse_include_statement ~attrs p in
      parse_newline_or_semicolon_structure p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Str.include_ ~loc include_statement)
    | Module ->
      Parser.begin_region p;
      let structure_item =
        parse_module_or_module_type_impl_or_pack_expr ~attrs p
      in
      parse_newline_or_semicolon_structure p;
      let loc = mk_loc start_pos (Parser.position p) in
      Parser.end_region p;
      Some {structure_item with pstr_loc = loc}
    | ModuleComment (loc, s) ->
      Parser.next p;
      Some
        (Ast_helper.Str.attribute ~loc
           ( {txt = "res.doc"; loc},
             PStr
               [
                 Ast_helper.Str.eval ~loc
                   (Ast_helper.Exp.constant ~loc (Ast_helper.Const.string s));
               ] ))
    | AtAt ->
      let attr = parse_standalone_attribute p in
      parse_newline_or_semicolon_structure p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Str.attribute ~loc attr)
    | PercentPercent -> (
      let (({Location.txt = name; loc = name_loc}, payload) as extension) =
        parse_extension ~module_language:true p
      in
      parse_newline_or_semicolon_structure p;
      let loc = mk_loc start_pos (Parser.position p) in
      match (name, Ast_raw.of_payload payload) with
      | "raw", Some source ->
        Some (Ast_helper.Str.raw ~attrs ~loc ~name_loc source)
      | _ -> Some (Ast_helper.Str.extension ~attrs ~loc extension))
    | token when Grammar.is_expr_start token ->
      let position = Parser.position p in
      let exp = parse_expr p in
      parse_newline_or_semicolon_structure p;
      let loc = mk_loc start_pos (Parser.position p) in
      Parser.check_progress ~position
        ~result:(Ast_helper.Str.eval ~loc ~attrs exp)
        p
    | _ -> (
      match attrs with
      | (({Asttypes.loc = attr_loc}, _) as attr) :: _ ->
        Parser.err ~start_pos:attr_loc.loc_start ~end_pos:attr_loc.loc_end p
          (Diagnostics.message (Error_messages.attribute_without_node attr));
        let expr = parse_expr p in
        Some
          (Ast_helper.Str.eval
             ~loc:(mk_loc (Parser.start_pos p) (Parser.position p))
             ~attrs expr)
      | _ -> None))
[@@progress Parser.next, Parser.expect]

(* include-statement ::= include module-expr *)
and parse_include_statement ~attrs p =
  let start_pos = Parser.start_pos p in
  Parser.expect Token.Include p;
  let mod_expr = parse_module_expr p in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Incl.mk ~loc ~attrs mod_expr

and parse_atomic_module_expr p =
  let start_pos = Parser.start_pos p in
  match Parser.peek p with
  | Uident _ident ->
    let longident = parse_module_long_ident ~lowercase:false p in
    Ast_helper.Mod.ident ~loc:longident.loc longident
  | Lbrace ->
    Parser.next p;
    let pending_structure_items = ref [] in
    let structure =
      Ast_helper.Mod.structure
        (parse_delimited_region ~grammar:Grammar.Structure ~closing:Rbrace
           ~f:(parse_structure_item_region pending_structure_items)
           p)
    in
    Parser.expect Rbrace p;
    let end_pos = Parser.position p in
    {structure with pmod_loc = mk_loc start_pos end_pos}
  | Lparen ->
    Parser.next p;
    let mod_expr =
      match Parser.peek p with
      | Rparen ->
        Ast_helper.Mod.structure ~loc:(mk_loc start_pos (Parser.position p)) []
      | _ -> parse_constrained_mod_expr p
    in
    Parser.expect Rparen p;
    mod_expr
  | Lident "unpack" -> (
    (* TODO: should this be made a keyword?? *)
    Parser.next p;
    Parser.expect Lparen p;
    let expr = parse_expr p in
    match Parser.peek p with
    | Colon ->
      let colon_start = Parser.start_pos p in
      Parser.next p;
      let attrs = parse_attributes p in
      let package_type = parse_package_type ~start_pos:colon_start ~attrs p in
      Parser.expect Rparen p;
      let loc = mk_loc start_pos (Parser.position p) in
      let constraint_expr = Ast_helper.Exp.constraint_ ~loc expr package_type in
      Ast_helper.Mod.unpack ~loc constraint_expr
    | _ ->
      Parser.expect Rparen p;
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Mod.unpack ~loc expr)
  | Percent ->
    let extension = parse_extension p in
    let loc = mk_loc start_pos (Parser.position p) in
    Ast_helper.Mod.extension ~loc extension
  | token ->
    Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
    Recover.default_module_expr ()

and parse_primary_mod_expr p =
  let start_pos = Parser.start_pos p in
  let mod_expr = parse_atomic_module_expr p in
  let rec loop p mod_expr =
    match Parser.peek p with
    | Lparen when (Parser.position p).pos_lnum == (Parser.start_pos p).pos_lnum
      ->
      loop p (parse_module_application p mod_expr)
    | _ -> mod_expr
  in
  let mod_expr = loop p mod_expr in
  {mod_expr with pmod_loc = mk_loc start_pos (Parser.position p)}

(*
 * functor-arg ::=
 *  | uident : modtype
 *  | _ : modtype
 *  | modtype           --> "punning" for _ : modtype
 *  | attributes functor-arg
 *)
and parse_functor_arg p =
  let start_pos = Parser.start_pos p in
  let attrs = parse_attributes p in
  match Parser.peek p with
  | Uident ident -> (
    Parser.next p;
    let uident_end_pos = Parser.position p in
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      let module_type = parse_module_type p in
      let loc = mk_loc start_pos uident_end_pos in
      let arg_name = Location.mkloc ident loc in
      Some (attrs, arg_name, Some module_type, start_pos)
    | Dot ->
      Parser.next p;
      let module_type =
        let module_long_ident =
          parse_module_long_ident_tail ~lowercase:false p start_pos
            (Longident.Lident ident)
        in
        Ast_helper.Mty.ident ~loc:module_long_ident.loc module_long_ident
      in
      let arg_name = Location.mknoloc "_" in
      Some (attrs, arg_name, Some module_type, start_pos)
    | _ ->
      let loc = mk_loc start_pos uident_end_pos in
      let mod_ident = Location.mkloc (Longident.Lident ident) loc in
      let module_type = Ast_helper.Mty.ident ~loc mod_ident in
      let arg_name = Location.mknoloc "_" in
      Some (attrs, arg_name, Some module_type, start_pos))
  | Underscore ->
    Parser.next p;
    let arg_name = Location.mkloc "_" (mk_loc start_pos (Parser.position p)) in
    Parser.expect Colon p;
    let module_type = parse_module_type p in
    Some (attrs, arg_name, Some module_type, start_pos)
  | Lparen ->
    Parser.next p;
    Parser.expect Rparen p;
    let arg_name = Location.mkloc "*" (mk_loc start_pos (Parser.position p)) in
    Some (attrs, arg_name, None, start_pos)
  | _ -> None

and parse_functor_args p =
  let start_pos = Parser.start_pos p in
  Parser.expect Lparen p;
  let args =
    parse_comma_delimited_region ~grammar:Grammar.FunctorArgs ~closing:Rparen
      ~f:parse_functor_arg p
  in
  Parser.expect Rparen p;
  match args with
  | [] ->
    [
      ( [],
        Location.mkloc "*" (mk_loc start_pos (Parser.position p)),
        None,
        start_pos );
    ]
  | args -> args

and parse_functor_module_expr p =
  let start_pos = Parser.start_pos p in
  let args = parse_functor_args p in
  let return_type =
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      Some (parse_module_type ~es6_arrow:false p)
    | _ -> None
  in
  Parser.expect EqualGreater p;
  let rhs_module_expr =
    let mod_expr = parse_module_expr p in
    match return_type with
    | Some mod_type ->
      Ast_helper.Mod.constraint_
        ~loc:
          (mk_loc mod_expr.pmod_loc.loc_start
             mod_type.Parsetree.pmty_loc.loc_end)
        mod_expr mod_type
    | None -> mod_expr
  in
  let end_pos = Parser.position p in
  let mod_expr =
    List.fold_right
      (fun (attrs, name, module_type, start_pos) acc ->
        Ast_helper.Mod.functor_ ~loc:(mk_loc start_pos end_pos) ~attrs name
          module_type acc)
      args rhs_module_expr
  in
  {mod_expr with pmod_loc = mk_loc start_pos end_pos}

(* module-expr	::=
 *  | module-path
 *  ∣	{ structure-items }
 *  ∣	functorArgs =>  module-expr
 *  ∣	module-expr(module-expr)
 *  ∣	( module-expr )
 *  ∣	( module-expr : module-type )
 *  | extension
 *  | attributes module-expr *)
and parse_module_expr p =
  let start_pos = Parser.start_pos p in
  let has_await =
    match Parser.peek p with
    | Await ->
      Parser.expect Await p;
      true
    | _ -> false
  in
  let attrs = parse_attributes p in
  let mod_expr =
    if is_es6_arrow_functor p then parse_functor_module_expr p
    else parse_primary_mod_expr p
  in
  (* The attributes after [await] belong to the await, like those of
     [@attr (await M)], and the module keeps its own: [await @b (@a M)] *)
  if has_await then
    Ast_helper.Mod.await
      ~loc:(mk_loc start_pos mod_expr.pmod_loc.loc_end)
      ~attrs mod_expr
  else
    {
      mod_expr with
      pmod_attributes = List.concat [mod_expr.pmod_attributes; attrs];
    }

and parse_constrained_mod_expr p =
  let mod_expr = parse_module_expr p in
  match Parser.peek p with
  | Colon ->
    Parser.next p;
    let mod_type = parse_module_type p in
    let loc = mk_loc mod_expr.pmod_loc.loc_start mod_type.pmty_loc.loc_end in
    Ast_helper.Mod.constraint_ ~loc mod_expr mod_type
  | _ -> mod_expr

and parse_constrained_mod_expr_region p =
  if Grammar.is_mod_expr_start (Parser.peek p) then
    Some (parse_constrained_mod_expr p)
  else None

and parse_module_application p mod_expr =
  let start_pos = Parser.start_pos p in
  Parser.expect Lparen p;
  let args =
    parse_comma_delimited_region ~grammar:Grammar.ModExprList ~closing:Rparen
      ~f:parse_constrained_mod_expr_region p
  in
  Parser.expect Rparen p;
  let args =
    match args with
    | [] ->
      let loc = mk_loc start_pos (Parser.position p) in
      [Ast_helper.Mod.structure ~loc []]
    | args -> args
  in
  List.fold_left
    (fun mod_expr arg ->
      Ast_helper.Mod.apply
        ~loc:
          (mk_loc mod_expr.Parsetree.pmod_loc.loc_start
             arg.Parsetree.pmod_loc.loc_end)
        mod_expr arg)
    mod_expr args

and parse_module_or_module_type_impl_or_pack_expr ~attrs p =
  let start_pos = Parser.start_pos p in
  Parser.expect Module p;
  match Parser.peek p with
  | Typ -> parse_module_type_impl ~attrs start_pos p
  | Lparen ->
    let expr = parse_first_class_module_expr ~start_pos p in
    let a = parse_primary_expr ~operand:expr p in
    let expr = parse_binary_expr ~a p 1 in
    let expr = parse_ternary_expr expr p in
    Ast_helper.Str.eval ~attrs expr
  | _ -> parse_maybe_rec_module_binding ~attrs ~start_pos p

and parse_module_type_impl ~attrs start_pos p =
  Parser.expect Typ p;
  let name_start = Parser.start_pos p in
  let name =
    match Parser.peek p with
    | Lident ident ->
      Parser.next p;
      let loc = mk_loc name_start (Parser.position p) in
      Location.mkloc ident loc
    | Uident ident ->
      Parser.next p;
      let loc = mk_loc name_start (Parser.position p) in
      Location.mkloc ident loc
    | t ->
      Parser.err p (Diagnostics.uident t);
      Location.mknoloc "_"
  in
  Parser.expect Equal p;
  let module_type = parse_module_type p in
  let module_type_declaration =
    Ast_helper.Mtd.mk ~attrs
      ~loc:(mk_loc name_start (Parser.position p))
      ~typ:module_type name
  in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Str.modtype ~loc module_type_declaration

(* definition	::=
   ∣	 module rec module-name :  module-type =  module-expr   { and module-name
   :  module-type =  module-expr } *)
and parse_maybe_rec_module_binding ~attrs ~start_pos p =
  match Parser.peek p with
  | Token.Rec ->
    Parser.next p;
    Ast_helper.Str.rec_module (parse_module_bindings ~start_pos ~attrs p)
  | _ ->
    Ast_helper.Str.module_
      (parse_module_binding ~attrs ~start_pos:(Parser.start_pos p) p)

and parse_module_binding ~attrs ~start_pos p =
  let name =
    match Parser.peek p with
    | Uident ident ->
      let start_pos = Parser.start_pos p in
      Parser.next p;
      let loc = mk_loc start_pos (Parser.position p) in
      Location.mkloc ident loc
    | t ->
      Parser.err p (Diagnostics.uident t);
      Location.mknoloc "_"
  in
  let body = parse_module_binding_body p in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Mb.mk ~attrs ~loc name body

and parse_module_binding_body p =
  (* TODO: make required with good error message when rec module binding *)
  let return_mod_type =
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      Some (parse_module_type p)
    | _ -> None
  in
  Parser.expect Equal p;
  let mod_expr = parse_module_expr p in
  match return_mod_type with
  | Some mod_type ->
    Ast_helper.Mod.constraint_
      ~loc:(mk_loc mod_type.pmty_loc.loc_start mod_expr.pmod_loc.loc_end)
      mod_expr mod_type
  | None -> mod_expr

(* module-name :  module-type =  module-expr
 * { and module-name :  module-type =  module-expr } *)
and parse_module_bindings ~attrs ~start_pos p =
  let rec loop p acc =
    let start_pos = Parser.start_pos p in
    let doc_attr : Parsetree.attributes =
      match Parser.peek p with
      | DocComment (loc, s) ->
        Parser.next p;
        [doc_comment_to_attribute loc s]
      | _ -> []
    in
    let attrs = doc_attr @ parse_attributes_and_binding p in
    match Parser.peek p with
    | And ->
      Parser.next p;
      ignore (Parser.optional p Module);
      (* over-parse for fault-tolerance *)
      let mod_binding = parse_module_binding ~attrs ~start_pos p in
      loop p (mod_binding :: acc)
    | _ -> List.rev acc
  in
  let first = parse_module_binding ~attrs ~start_pos p in
  loop p [first]

and parse_atomic_module_type p =
  let start_pos = Parser.start_pos p in
  let module_type =
    match Parser.peek p with
    | Uident _ | Lident _ ->
      (* Ocaml allows module types to end with lowercase: module Foo : bar = { ... }
       * lets go with uppercase terminal for now *)
      let module_long_ident = parse_module_long_ident ~lowercase:true p in
      Ast_helper.Mty.ident ~loc:module_long_ident.loc module_long_ident
    | Lparen ->
      Parser.next p;
      let mty = parse_module_type p in
      Parser.expect Rparen p;
      {mty with pmty_loc = mk_loc start_pos (Parser.position p)}
    | Lbrace ->
      Parser.next p;
      let pending_signature_items = ref [] in
      let spec =
        parse_delimited_region ~grammar:Grammar.Signature ~closing:Rbrace
          ~f:(parse_signature_item_region pending_signature_items)
          p
      in
      Parser.expect Rbrace p;
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Mty.signature ~loc spec
    | Module ->
      (* TODO: check if this is still atomic when implementing first class modules*)
      parse_module_type_of p
    | Percent ->
      let extension = parse_extension p in
      let loc = mk_loc start_pos (Parser.position p) in
      Ast_helper.Mty.extension ~loc extension
    | token ->
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      Recover.default_module_type ()
  in
  let module_type_loc = mk_loc start_pos (Parser.position p) in
  {module_type with pmty_loc = module_type_loc}

and parse_functor_module_type p =
  let start_pos = Parser.start_pos p in
  let args = parse_functor_args p in
  Parser.expect EqualGreater p;
  let rhs = parse_module_type p in
  let end_pos = Parser.position p in
  let mod_type =
    List.fold_right
      (fun (attrs, name, module_type, start_pos) acc ->
        Ast_helper.Mty.functor_ ~loc:(mk_loc start_pos end_pos) ~attrs name
          module_type acc)
      args rhs
  in
  {mod_type with pmty_loc = mk_loc start_pos end_pos}

(* Module types are the module-level equivalent of type expressions: they
 * specify the general shape and type properties of modules.
 *
 * module-type ::=
 *  | modtype-path
 *  | { signature }
 *  | ( module-type )               --> parenthesized module-type
 *  | functor-args => module-type   --> functor
 *  | module-type => module-type    --> functor
 *  | module type of module-expr
 *  | attributes module-type
 *  | module-type with-mod-constraints
 *  | extension
 *)
and parse_module_type ?(es6_arrow = true) ?(with_ = true) p =
  let attrs = parse_attributes p in
  let modty =
    if es6_arrow && is_es6_arrow_functor p then parse_functor_module_type p
    else
      let modty = parse_atomic_module_type p in
      match Parser.peek p with
      | EqualGreater when es6_arrow == true ->
        Parser.next p;
        let rhs = parse_module_type ~with_:false p in
        let str = Location.mknoloc "_" in
        let loc = mk_loc modty.pmty_loc.loc_start (Parser.position p) in
        Ast_helper.Mty.functor_ ~loc str (Some modty) rhs
      | _ -> modty
  in
  let module_type =
    {modty with pmty_attributes = List.concat [modty.pmty_attributes; attrs]}
  in
  if with_ then parse_with_constraints module_type p else module_type

and parse_with_constraints module_type p =
  match Parser.peek p with
  | Lident "with" ->
    Parser.next p;
    let first = parse_with_constraint p in
    let rec loop p acc =
      match Parser.peek p with
      | And ->
        Parser.next p;
        loop p (parse_with_constraint p :: acc)
      | _ -> List.rev acc
    in
    let constraints = loop p [first] in
    let loc = mk_loc module_type.pmty_loc.loc_start (Parser.position p) in
    Ast_helper.Mty.with_ ~loc module_type constraints
  | _ -> module_type

(* mod-constraint	::=
 *  |  type typeconstr<type-params> type-equation type-constraints?
 *  ∣	 type typeconstr-name<type-params> := typexpr
 *  ∣	 module module-path = extended-module-path
 *  ∣	 module module-path :=  extended-module-path
 *
 *  TODO: split this up into multiple functions, better errors *)
and parse_with_constraint p =
  match Parser.peek p with
  | Module -> (
    Parser.next p;
    let module_path = parse_module_long_ident ~lowercase:false p in
    match Parser.peek p with
    | ColonEqual ->
      Parser.next p;
      let lident = parse_module_long_ident ~lowercase:false p in
      Parsetree.Pwith_modsubst (module_path, lident)
    | Equal ->
      Parser.next p;
      let lident = parse_module_long_ident ~lowercase:false p in
      Parsetree.Pwith_module (module_path, lident)
    | token ->
      (* TODO: revisit *)
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      let lident = parse_module_long_ident ~lowercase:false p in
      Parsetree.Pwith_modsubst (module_path, lident))
  | Typ -> (
    Parser.next p;
    let type_constr = parse_value_path p in
    let params = parse_type_params ~parent:type_constr p in
    match Parser.peek p with
    | ColonEqual ->
      Parser.next p;
      let typ_expr = parse_typ_expr p in
      Parsetree.Pwith_typesubst
        ( type_constr,
          Ast_helper.Type.mk ~loc:type_constr.loc ~params ~manifest:typ_expr
            (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) )
    | Equal ->
      Parser.next p;
      let private_flag =
        if Parser.optional p Token.Private then Asttypes.Private
        else Asttypes.Public
      in
      let typ_expr = parse_typ_expr p in
      let type_constraints = parse_type_constraints p in
      Parsetree.Pwith_type
        ( type_constr,
          Ast_helper.Type.mk ~loc:type_constr.loc ~priv:private_flag ~params
            ~manifest:typ_expr ~cstrs:type_constraints
            (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) )
    | token ->
      (* TODO: revisit *)
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      let typ_expr = parse_typ_expr p in
      let type_constraints = parse_type_constraints p in
      Parsetree.Pwith_type
        ( type_constr,
          Ast_helper.Type.mk ~loc:type_constr.loc ~params ~manifest:typ_expr
            ~cstrs:type_constraints
            (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) ))
  | token ->
    (* TODO: implement recovery strategy *)
    Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
    Parsetree.Pwith_type
      ( Location.mknoloc (Longident.Lident ""),
        Ast_helper.Type.mk ~params:[] ~manifest:(Recover.default_type ())
          ~cstrs:[] (Location.mknoloc "") )

and parse_module_type_of p =
  let start_pos = Parser.start_pos p in
  Parser.expect Module p;
  Parser.expect Typ p;
  Parser.expect Of p;
  let module_expr = parse_module_expr p in
  Ast_helper.Mty.typeof_ ~loc:(mk_loc start_pos (Parser.position p)) module_expr

and parse_newline_or_semicolon_signature p =
  match Parser.peek p with
  | Semicolon -> Parser.next p
  | token when Grammar.is_signature_item_start token ->
    if (Parser.position p).pos_lnum < (Parser.start_pos p).pos_lnum then ()
    else
      Parser.err ~start_pos:(Parser.position p) ~end_pos:(Parser.end_pos p) p
        (Diagnostics.message
           "consecutive specifications on a line must be separated by ';' or a \
            newline")
  | _ -> ()

and parse_signature_item_region pending_signature_items p =
  let start_pos = Parser.start_pos p in
  match !pending_signature_items with
  | item :: rest ->
    pending_signature_items := rest;
    Some item
  | [] -> (
    let attrs = parse_attributes p in
    match Parser.peek p with
    | Let {unwrap} ->
      if unwrap then (
        Parser.err ~start_pos ~end_pos:(Parser.end_pos p) p
          (Diagnostics.message Error_messages.experimental_let_unwrap_sig);
        Parser.next p);
      Parser.begin_region p;
      let value_desc = parse_sign_let_desc ~attrs p in
      parse_newline_or_semicolon_signature p;
      let loc = mk_loc start_pos (Parser.position p) in
      Parser.end_region p;
      Some (Ast_helper.Sig.value ~loc value_desc)
    | Typ -> (
      Parser.begin_region p;
      match parse_type_definition_or_extension ~attrs p with
      | TypeDef {rec_flag; types} ->
        parse_newline_or_semicolon_signature p;
        let loc = mk_loc start_pos (Parser.position p) in
        Parser.end_region p;
        Some (Ast_helper.Sig.type_ ~loc rec_flag types)
      | TypeExt ext ->
        parse_newline_or_semicolon_signature p;
        let loc = mk_loc start_pos (Parser.position p) in
        Parser.end_region p;
        Some (Ast_helper.Sig.type_extension ~loc ext))
    | External -> (
      let external_def, inline_types = parse_external_def ~attrs ~start_pos p in
      parse_newline_or_semicolon_signature p;
      let loc = mk_loc start_pos (Parser.position p) in
      match inline_types with
      | [] -> Some (Ast_helper.Sig.value ~loc external_def)
      | _ ->
        let type_item =
          Ast_helper.Sig.type_ ~loc Asttypes.Recursive inline_types
        in
        let value_item = Ast_helper.Sig.value ~loc external_def in
        pending_signature_items := value_item :: !pending_signature_items;
        Some type_item)
    | Exception ->
      let exception_def = parse_exception_def ~attrs p in
      parse_newline_or_semicolon_signature p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Sig.exception_ ~loc exception_def)
    | Open ->
      let open_description = parse_open_description ~attrs p in
      parse_newline_or_semicolon_signature p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Sig.open_ ~loc open_description)
    | Include ->
      Parser.next p;
      let module_type = parse_module_type p in
      let include_description =
        Ast_helper.Incl.mk
          ~loc:(mk_loc start_pos (Parser.position p))
          ~attrs module_type
      in
      parse_newline_or_semicolon_signature p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Sig.include_ ~loc include_description)
    | Module -> (
      Parser.begin_region p;
      Parser.next p;
      match Parser.peek p with
      | Uident _ ->
        let mod_decl = parse_module_declaration_or_alias ~attrs p in
        parse_newline_or_semicolon_signature p;
        let loc = mk_loc start_pos (Parser.position p) in
        Parser.end_region p;
        Some (Ast_helper.Sig.module_ ~loc mod_decl)
      | Rec ->
        let rec_module = parse_rec_module_spec ~attrs ~start_pos p in
        parse_newline_or_semicolon_signature p;
        let loc = mk_loc start_pos (Parser.position p) in
        Parser.end_region p;
        Some (Ast_helper.Sig.rec_module ~loc rec_module)
      | Typ ->
        let mod_type_decl = parse_module_type_declaration ~attrs ~start_pos p in
        Parser.end_region p;
        Some mod_type_decl
      | _t ->
        let mod_decl = parse_module_declaration_or_alias ~attrs p in
        parse_newline_or_semicolon_signature p;
        let loc = mk_loc start_pos (Parser.position p) in
        Parser.end_region p;
        Some (Ast_helper.Sig.module_ ~loc mod_decl))
    | AtAt ->
      let attr = parse_standalone_attribute p in
      parse_newline_or_semicolon_signature p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Sig.attribute ~loc attr)
    | ModuleComment (loc, s) ->
      Parser.next p;
      Some
        (Ast_helper.Sig.attribute ~loc
           ( {txt = "res.doc"; loc},
             PStr
               [
                 Ast_helper.Str.eval ~loc
                   (Ast_helper.Exp.constant ~loc (Ast_helper.Const.string s));
               ] ))
    | PercentPercent ->
      let extension = parse_extension ~module_language:true p in
      parse_newline_or_semicolon_signature p;
      let loc = mk_loc start_pos (Parser.position p) in
      Some (Ast_helper.Sig.extension ~attrs ~loc extension)
    | _ -> (
      match attrs with
      | (({Asttypes.loc = attr_loc}, _) as attr) :: _ ->
        Parser.err ~start_pos:attr_loc.loc_start ~end_pos:attr_loc.loc_end p
          (Diagnostics.message (Error_messages.attribute_without_node attr));
        Some Recover.default_signature_item
      | _ -> None))
[@@progress Parser.next, Parser.expect]

(* module rec module-name :  module-type  { and module-name:  module-type } *)
and parse_rec_module_spec ~attrs ~start_pos p =
  Parser.expect Rec p;
  let rec loop p spec =
    let start_pos = Parser.start_pos p in
    let attrs = parse_attributes_and_binding p in
    match Parser.peek p with
    | And ->
      (* TODO: give a good error message when with constraint, no parens
       * and ASet: (Set.S with type elt = A.t)
       * and BTree: (Btree.S with type elt = A.t)
       * Without parens, the `and` signals the start of another
       * `with-constraint`
       *)
      Parser.expect And p;
      let decl = parse_rec_module_declaration ~attrs ~start_pos p in
      loop p (decl :: spec)
    | _ -> List.rev spec
  in
  let first = parse_rec_module_declaration ~attrs ~start_pos p in
  loop p [first]

(* module-name : module-type *)
and parse_rec_module_declaration ~attrs ~start_pos p =
  let name =
    match Parser.peek p with
    | Uident mod_name ->
      let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      Location.mkloc mod_name loc
    | t ->
      Parser.err p (Diagnostics.uident t);
      Location.mknoloc "_"
  in
  Parser.expect Colon p;
  let mod_type = parse_module_type p in
  Ast_helper.Md.mk
    ~loc:(mk_loc start_pos (Parser.position p))
    ~attrs name mod_type

and parse_module_declaration_or_alias ~attrs p =
  let start_pos = Parser.start_pos p in
  let module_name =
    match Parser.peek p with
    | Uident ident ->
      let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      Location.mkloc ident loc
    | t ->
      Parser.err p (Diagnostics.uident t);
      Location.mknoloc "_"
  in
  let body =
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      parse_module_type p
    | Equal -> (
      Parser.next p;
      match Parser.peek p with
      | Lbrace ->
        (* Parse `module M = {` as `module M : {` *)
        parse_module_type p
      | _ ->
        let lident = parse_module_long_ident ~lowercase:false p in
        Ast_helper.Mty.alias lident)
    | token ->
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      Recover.default_module_type ()
  in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Md.mk ~loc ~attrs module_name body

and parse_module_type_declaration ~attrs ~start_pos p =
  Parser.expect Typ p;
  let name_start = Parser.start_pos p in
  let module_name =
    match Parser.peek p with
    | Uident ident ->
      let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      Location.mkloc ident loc
    | Lident ident ->
      let loc = mk_loc (Parser.start_pos p) (Parser.end_pos p) in
      Parser.next p;
      Location.mkloc ident loc
    | t ->
      Parser.err p (Diagnostics.uident t);
      Location.mknoloc "_"
  in
  let typ =
    match Parser.peek p with
    | Equal ->
      Parser.next p;
      Some (parse_module_type p)
    | _ -> None
  in
  (* From the name, like a module type declaration in a structure *)
  let module_decl =
    Ast_helper.Mtd.mk ~attrs
      ~loc:(mk_loc name_start (Parser.position p))
      ?typ module_name
  in
  Ast_helper.Sig.modtype ~loc:(mk_loc start_pos (Parser.position p)) module_decl

and parse_sign_let_desc ~attrs p =
  let start_pos = Parser.start_pos p in
  Parser.optional p (Let {unwrap = false}) |> ignore;
  let name, loc = parse_lident p in
  let name = Location.mkloc name loc in
  Parser.expect Colon p;
  let typ_expr = parse_poly_type_expr p in
  let loc = mk_loc start_pos (Parser.position p) in
  Ast_helper.Val.mk ~loc ~attrs name typ_expr

(* attr-id	::=	lowercase-ident
   ∣	  capitalized-ident
   ∣	  attr-id .  attr-id *)
and parse_attribute_id ~start_pos p =
  let rec loop p acc =
    match Parser.peek p with
    | Lident ident | Uident ident -> (
      Parser.next p;
      let id = acc ^ ident in
      match Parser.peek p with
      | Dot ->
        Parser.next p;
        loop p (id ^ ".")
      | _ -> id)
    | token when Token.is_keyword token -> (
      Parser.next p;
      let id = acc ^ Token.to_string token in
      match Parser.peek p with
      | Dot ->
        Parser.next p;
        loop p (id ^ ".")
      | _ -> id)
    | token ->
      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
      acc
  in
  let id = loop p "" in
  let end_pos = Parser.position p in
  Location.mkloc id (mk_loc start_pos end_pos)

(*
 * payload ::=  empty
 *          |  ( structure-item )
 *
 * TODO: what about multiple structure items?
 * @attr({let x = 1; let x = 2})
 *
 * Also what about type-expressions and specifications?
 * @attr(:myType) ???
 *)
and parse_payload p =
  match Parser.peek p with
  | Lparen when (Parser.start_pos p).pos_cnum = (Parser.position p).pos_cnum
    -> (
    Parser.leave_breadcrumb p Grammar.AttributePayload;
    Parser.next p;
    match Parser.peek p with
    | Colon ->
      Parser.next p;
      let payload =
        if Grammar.is_signature_item_start (Parser.peek p) then
          let pending_signature_items = ref [] in
          Parsetree.PSig
            (parse_delimited_region ~grammar:Grammar.Signature ~closing:Rparen
               ~f:(parse_signature_item_region pending_signature_items)
               p)
        else Parsetree.PTyp (parse_typ_expr p)
      in
      Parser.expect Rparen p;
      Parser.eat_breadcrumb p;
      payload
    | Question ->
      Parser.next p;
      let pattern = parse_pattern p in
      let expr =
        match Parser.peek p with
        | When | If ->
          Parser.next p;
          Some (parse_expr p)
        | _ -> None
      in
      Parser.expect Rparen p;
      Parser.eat_breadcrumb p;
      Parsetree.PPat (pattern, expr)
    | _ ->
      let pending_structure_items = ref [] in
      let items =
        parse_delimited_region ~grammar:Grammar.Structure ~closing:Rparen
          ~f:(parse_structure_item_region pending_structure_items)
          p
      in
      Parser.expect Rparen p;
      Parser.eat_breadcrumb p;
      Parsetree.PStr items)
  | _ -> Parsetree.PStr []

(* type attribute = string loc * payload *)
and parse_attribute p =
  match Parser.peek p with
  | At ->
    let start_pos = Parser.start_pos p in
    Parser.next p;
    let attr_id = parse_attribute_id ~start_pos p in
    let payload = parse_payload p in
    Some (attr_id, payload)
  | DocComment (loc, s) ->
    Parser.next p;
    Some (doc_comment_to_attribute loc s)
  | _ -> None

and doc_comment_to_attribute loc s : Parsetree.attribute =
  ( {txt = "res.doc"; loc},
    PStr
      [
        Ast_helper.Str.eval ~loc
          (Ast_helper.Exp.constant ~loc (Ast_helper.Const.string s));
      ] )

and parse_attributes p =
  parse_region p ~grammar:Grammar.Attribute ~f:parse_attribute

(*
 * standalone-attribute ::=
 *  | @@ atribute-id
 *  | @@ attribute-id ( structure-item )
 *)
and parse_standalone_attribute p =
  let start_pos = Parser.start_pos p in
  Parser.expect AtAt p;
  let attr_id = parse_attribute_id ~start_pos p in
  let payload = parse_payload p in
  (attr_id, payload)

(* extension	::=	% attr-id  attr-payload
 *              | %% attr-id(
 *  expr	::=	 ...
 *    ∣	 extension
 *
 *  typexpr	::=	 ...
 *    ∣	 extension
 *
 *  pattern	::=	 ...
 *    ∣	 extension
 *
 *  module-expr	::=	 ...
 *    ∣	 extension
 *
 *  module-type	::=	 ...
 *    ∣	 extension
 *
 *  class-expr	::=	 ...
 *    ∣	 extension
 *
 *  class-type	::=	 ...
 *    ∣	 extension
 *
 *
 * item extension nodes usable in structures and signature
 *
 * item-extension ::= %% attr-id
 *                  | %% attr-id(structure-item)
 *
 *  attr-payload ::= structure-item
 *
 *  ~moduleLanguage represents whether we're on the module level or not
 *)
and parse_extension ?(module_language = false) p =
  let start_pos = Parser.start_pos p in
  if module_language then Parser.expect PercentPercent p
  else Parser.expect Percent p;
  let attr_id = parse_attribute_id ~start_pos p in
  let payload = parse_payload p in
  (match attr_id.txt with
  | "re" ->
    Parser.err ~start_pos:attr_id.loc.loc_start ~end_pos:attr_id.loc.loc_end p
      (Diagnostics.message
         "The %re extension has been removed. Use a regexp literal such as \
          /abc/i.")
  | "debugger" ->
    Parser.err ~start_pos:attr_id.loc.loc_start ~end_pos:attr_id.loc.loc_end p
      (Diagnostics.message
         "The %debugger extension has been removed. Use debugger() instead.")
  | _ -> ());
  (attr_id, payload)

(* module signature on the file level *)
let parse_specification p : Parsetree.signature =
  let pending_signature_items = ref [] in
  let signature =
    parse_region p ~grammar:Grammar.Specification
      ~f:(parse_signature_item_region pending_signature_items)
  in
  Parser.finish p;
  signature

(* module structure on the file level *)
let parse_implementation p : Parsetree.structure =
  let pending_structure_items = ref [] in
  let structure =
    parse_region p ~grammar:Grammar.Implementation
      ~f:(parse_structure_item_region pending_structure_items)
  in
  Parser.finish p;
  structure