hphp/hack/src/parser/full_fidelity_parser_helpers.ml

   1 (**
   2  * Copyright (c) 2016, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 module WithSyntax(Syntax: Syntax_sig.Syntax_S) = struct
  11
  12 module Token = Syntax.Token
  13 module SyntaxKind = Full_fidelity_syntax_kind
  14 module TokenKind = Full_fidelity_token_kind
  15 module SyntaxError = Full_fidelity_syntax_error
  16 module Trivia = Token.Trivia
  17 module SourceText = Full_fidelity_source_text
  18 module Env = Full_fidelity_parser_env
  19 module type SC_S = SmartConstructors.SmartConstructors_S
  20
  21 open Syntax
  22
  23 module type Lexer_S = Full_fidelity_lexer_sig.WithToken(Syntax.Token).Lexer_S
  24
  25 module WithLexer(Lexer : Lexer_S) = struct
  26 module type Parser_S = ParserSig.WithSyntax(Syntax).WithLexer(Lexer).Parser_S
  27
  28 module WithParser(Parser : Parser_S) = struct
  29   open Parser
  30
  31   let make_list parser items =
  32     Make.list parser (pos parser) items
  33
  34   module NextToken : sig
  35     val next_token : t -> t * Syntax.Token.t
  36     val fetch_token : t -> t * Parser.SC.r
  37   end = struct
  38     let next_token_impl parser =
  39       let lexer = lexer parser in
  40       let (lexer, token) = Lexer.next_token lexer in
  41       let parser = with_lexer parser lexer in
  42       (* ERROR RECOVERY: Check if the parser's carring ExtraTokenError trivia.
  43        * If so, clear it and add it to the leading trivia of the current token. *)
  44        let (parser, token) =
  45          match skipped_tokens parser with
  46          | [] -> (parser, token)
  47          | skipped_tokens ->
  48            let trivialise_token acc t =
  49              (* Every bit of a skipped token must end up in `acc`, so push all the
  50              * token's trailing trivia, then push the "trivialised" token itself,
  51              * followed by the leading trivia. *)
  52              let prepend_onto elt_list elt = List.cons elt elt_list in
  53              let acc = List.fold_left prepend_onto acc (Token.trailing t) in
  54                let acc = Trivia.make_extra_token_error
  55                   (Lexer.source lexer) (Lexer.start_offset lexer) (Token.width t)
  56                   :: acc in
  57              List.fold_left prepend_onto acc (Token.leading t)
  58            in
  59            let leading =
  60              List.fold_left trivialise_token (Token.leading token) skipped_tokens
  61            in
  62            let token = Token.with_leading leading token in
  63            let parser = clear_skipped_tokens parser in
  64            (parser, token)
  65          in
  66       (parser, token)
  67
  68     let magic_cache = Little_magic_cache.make ()
  69     let next_token = Little_magic_cache.memoize magic_cache next_token_impl
  70     let fetch_token parser =
  71       let (parser, token) = next_token parser in
  72       Make.token parser token
  73   end
  74
  75   include NextToken
  76
  77   let next_token_no_trailing parser =
  78     let lexer = lexer parser in
  79     let (lexer, token) = Lexer.next_token_no_trailing lexer in
  80     let parser = with_lexer parser lexer in
  81     (parser, token)
  82
  83   let next_docstring_header parser =
  84     let lexer = lexer parser in
  85     let (lexer, token, name) = Lexer.next_docstring_header lexer in
  86     let parser = with_lexer parser lexer in
  87     (parser, token, name)
  88
  89   let next_token_in_string parser literal_kind =
  90     let lexer = lexer parser in
  91     let (lexer, token) = Lexer.next_token_in_string lexer literal_kind in
  92     let parser = with_lexer parser lexer in
  93     (parser, token)
  94
  95   let peek_token ?(lookahead=0) parser =
  96     let rec lex_ahead lexer n =
  97       let (next_lexer, token) = Lexer.next_token lexer in
  98       match n with
  99       | 0 -> token
 100       | _ -> lex_ahead next_lexer (n-1)
 101     in
 102       lex_ahead (lexer parser) lookahead
 103
 104   let next_token_as_name parser =
 105     (* TODO: This isn't right.  Pass flags to the lexer. *)
 106     let lexer = lexer parser in
 107     let (lexer, token) = Lexer.next_token_as_name lexer in
 108     let parser = with_lexer parser lexer in
 109     (parser, token)
 110
 111   let peek_token_as_name ?(lookahead=0) parser =
 112     let rec lex_ahead lexer n =
 113       let (next_lexer, token) = Lexer.next_token_as_name lexer in
 114       match n with
 115       | 0 -> token
 116       | _ -> lex_ahead next_lexer (n-1)
 117     in
 118       lex_ahead (lexer parser) lookahead
 119
 120   let peek_token_kind ?(lookahead=0) parser =
 121     Token.kind (peek_token ~lookahead parser)
 122
 123   let scan_markup parser ~is_leading_section =
 124     let (lexer, markup, suffix) =
 125       Lexer.scan_markup (lexer parser) ~is_leading_section
 126     in
 127     with_lexer parser lexer, markup, suffix
 128
 129   let rescan_halt_compiler parser right_brace =
 130     let lexer = lexer parser in
 131     let (lexer, right_brace) = Lexer.rescan_halt_compiler lexer right_brace in
 132     with_lexer parser lexer, right_brace
 133
 134   let error_offsets ?(on_whole_token=false) parser =
 135     let lexer = lexer parser in
 136     if on_whole_token then
 137       let token = peek_token parser in
 138       let start_offset =
 139         (Lexer.end_offset lexer) + (Token.leading_width token) in
 140       let end_offset = start_offset + (Token.width token) in
 141       (start_offset, end_offset)
 142     else
 143       let start_offset = Lexer.start_offset lexer in
 144       let end_offset = Lexer.end_offset lexer in
 145       (start_offset, end_offset)
 146
 147   (* This function reports an error starting at the current location of the
 148    * parser. Setting on_whole_token=false will report the error only on trivia,
 149    * which is useful in cases such as when "a semicolon is expected here" before
 150    * the current node. However, setting on_whole_token=true will report the error
 151    * only on the non-trivia text of the next token parsed, which is useful
 152    * in cases like "flagging an entire token as an extra". *)
 153   let with_error ?(on_whole_token=false) parser message =
 154     let (start_offset, end_offset) = error_offsets parser ~on_whole_token in
 155     let error = SyntaxError.make start_offset end_offset message in
 156     let errors = errors parser in
 157     with_errors parser (error :: errors)
 158
 159   let current_token_text parser =
 160     let token = peek_token parser in
 161     let token_width = Token.width token in
 162     let token_str = Lexer.current_text_at
 163       (lexer parser) token_width 0 in
 164     token_str
 165
 166   let skip_and_log_unexpected_token ?(generate_error=true) parser =
 167     let parser =
 168       if generate_error then
 169         let extra_str = current_token_text parser in
 170         with_error parser (SyntaxError.error1057 extra_str) ~on_whole_token:true
 171       else parser in
 172     let parser, token = next_token parser in
 173     let skipped_tokens = token :: skipped_tokens parser in
 174     with_skipped_tokens parser skipped_tokens
 175
 176   (* Returns true if the strings underlying two tokens are of the same length
 177    * but with one character different. *)
 178   let one_character_different str1 str2 =
 179     if String.length str1 != String.length str2 then false
 180     else begin
 181       let rec off_by_one str1 str2 =
 182         let str_len = String.length str1 in (* both strings have same length *)
 183         if str_len = 0 then true
 184         else begin
 185           let rest_of_str1 = String.sub str1 1 (str_len - 1) in
 186           let rest_of_str2 = String.sub str2 1 (str_len - 1) in
 187           if Char.equal (String.get str1 0) (String.get str2 0)
 188           then off_by_one rest_of_str1 rest_of_str2
 189           (* Allow only one mistake *)
 190           else (String.compare rest_of_str1 rest_of_str2) = 0
 191         end
 192       in
 193       off_by_one str1 str2
 194     end
 195
 196   (* Compare the text of the token we have in hand to the text of the
 197    * anticipated kind. Note: this automatically returns false for any
 198    * TokenKinds of length 1. *)
 199   let is_misspelled_kind kind token_str =
 200     let tokenkind_str = TokenKind.to_string kind in
 201     if String.length tokenkind_str <= 1 then false
 202     else
 203       one_character_different tokenkind_str token_str
 204
 205   let is_misspelled_from kind_list token_str =
 206     List.exists (fun kind -> is_misspelled_kind kind token_str) kind_list
 207
 208   (* If token_str is a misspelling (by our narrow definition of misspelling)
 209    * of a TokenKind from kind_list, return the TokenKind that token_str is a
 210    * misspelling of. Otherwise, return None. *)
 211   let suggested_kind_from kind_list token_str =
 212     Hh_core.List.find_map kind_list ~f:(fun kind ->
 213       if is_misspelled_kind kind token_str then Some kind else None)
 214
 215   let skip_and_log_misspelled_token parser required_kind =
 216     let received_str = current_token_text parser in
 217     let required_str = TokenKind.to_string required_kind in
 218     let parser = with_error parser
 219       (SyntaxError.error1058 received_str required_str) ~on_whole_token:true in
 220     skip_and_log_unexpected_token ~generate_error:false parser
 221
 222   let require_and_return_token parser kind error =
 223     let (parser1, token) = next_token parser in
 224     if (Token.kind token) = kind then
 225       (parser1, Some token)
 226     else begin
 227       (* ERROR RECOVERY: Look at the next token after this. Is it the one we
 228        * require? If so, process the current token as extra and return the next
 229        * one. Otherwise, create a missing token for what we required,
 230        * and continue on from the current token (don't skip it). *)
 231       let next_kind = peek_token_kind ~lookahead:1 parser in
 232       if next_kind = kind then
 233         let parser = skip_and_log_unexpected_token parser in
 234         let (parser, token) = next_token parser in
 235         (parser, Some token)
 236       else begin
 237         (* ERROR RECOVERY: We know we didn't encounter an extra token.
 238          * So, as a second line of defense, check if the current token
 239          * is a misspelling, by our existing narrow definition of misspelling. *)
 240         if is_misspelled_kind kind (current_token_text parser) then
 241           let parser = skip_and_log_misspelled_token parser kind in
 242           (parser, None)
 243         else
 244           let parser = with_error parser error in
 245           (parser, None)
 246       end
 247     end
 248
 249   let require_token_one_of parser kinds error =
 250     let (parser1, token) = next_token parser in
 251     if List.mem (Token.kind token) kinds
 252     then Make.token parser1 token
 253     else begin
 254       (* ERROR RECOVERY: Look at the next token after this. Is it the one we
 255        * require? If so, process the current token as extra and return the next
 256        * one. Otherwise, create a missing token for what we required,
 257        * and continue on from the current token (don't skip it). *)
 258       let next_kind = peek_token_kind ~lookahead:1 parser in
 259       if List.mem next_kind kinds then
 260         let parser = skip_and_log_unexpected_token parser in
 261         let (parser, token) = next_token parser in
 262         Make.token parser token
 263       else begin
 264         (* ERROR RECOVERY: We know we didn't encounter an extra token.
 265          * So, as a second line of defense, check if the current token
 266          * is a misspelling, by our existing narrow definition of misspelling. *)
 267         let is_misspelling k =
 268           is_misspelled_kind k (current_token_text parser)
 269         in
 270         if List.exists is_misspelling kinds then
 271           let kind = List.(hd @@ filter is_misspelling kinds) in
 272           let parser = skip_and_log_misspelled_token parser kind in
 273           Make.missing parser (pos parser)
 274         else
 275           let parser = with_error parser error in
 276           Make.missing parser (pos parser)
 277       end
 278     end
 279
 280
 281   let require_token parser kind error =
 282     (* Must behave as `require_token_one_of parser [kind] error` *)
 283     let (parser1, token) = next_token parser in
 284     if (Token.kind token) = kind then
 285       Make.token parser1 token
 286     else begin
 287       (* ERROR RECOVERY: Look at the next token after this. Is it the one we
 288        * require? If so, process the current token as extra and return the next
 289        * one. Otherwise, create a missing token for what we required,
 290        * and continue on from the current token (don't skip it). *)
 291       let next_kind = peek_token_kind ~lookahead:1 parser in
 292       if next_kind = kind then
 293         let parser = skip_and_log_unexpected_token parser in
 294         let (parser, token) = next_token parser in
 295         Make.token parser token
 296       else begin
 297         (* ERROR RECOVERY: We know we didn't encounter an extra token.
 298          * So, as a second line of defense, check if the current token
 299          * is a misspelling, by our existing narrow definition of misspelling. *)
 300         if is_misspelled_kind kind (current_token_text parser) then
 301           let parser = skip_and_log_misspelled_token parser kind in
 302           Make.missing parser (pos parser)
 303         else
 304           let parser = with_error parser error in
 305           Make.missing parser (pos parser)
 306       end
 307     end
 308
 309   let require_required parser =
 310     require_token parser TokenKind.Required SyntaxError.error1051
 311
 312   let require_name parser =
 313     require_token parser TokenKind.Name SyntaxError.error1004
 314
 315   let require_name_allow_keywords parser =
 316     let (parser1, token) = next_token_as_name parser in
 317     if (Token.kind token) = TokenKind.Name then
 318       Make.token parser1 token
 319     else
 320       (* ERROR RECOVERY: Create a missing token for the expected token,
 321          and continue on from the current token. Don't skip it. *)
 322       let parser = with_error parser SyntaxError.error1004 in
 323       Make.missing parser (pos parser)
 324
 325   let require_name_allow_std_constants parser =
 326     let start_offset = Lexer.end_offset @@ lexer parser in
 327     let (parser1, token) = require_name_allow_keywords parser in
 328     let end_offset = Lexer.end_offset @@ lexer parser1 in
 329     let source = Lexer.source @@ lexer parser in
 330     let text = SourceText.sub source start_offset (end_offset - start_offset) in
 331     match String.lowercase_ascii text with
 332     | "true" | "false" | "null" -> (parser1, token)
 333     | _ -> require_name parser
 334
 335   let next_xhp_category_name parser =
 336     let lexer = lexer parser in
 337     let (lexer, token) = Lexer.next_xhp_category_name lexer in
 338     let parser = with_lexer parser lexer in
 339     (parser, token)
 340
 341   (* We have a number of issues involving xhp class names, which begin with
 342      a colon and may contain internal colons and dashes.  These are some
 343      helper methods to deal with them. *)
 344
 345   let is_next_name parser =
 346     Lexer.is_next_name (lexer parser)
 347
 348   let next_xhp_name parser =
 349     assert(is_next_name parser);
 350     let lexer = lexer parser in
 351     let (lexer, token) = Lexer.next_xhp_name lexer in
 352     let parser = with_lexer parser lexer in
 353     (parser, token)
 354
 355   let is_next_xhp_class_name parser =
 356     Lexer.is_next_xhp_class_name (lexer parser)
 357
 358   let next_xhp_class_name parser =
 359     assert(is_next_xhp_class_name parser);
 360     let lexer = lexer parser in
 361     let (lexer, token) = Lexer.next_xhp_class_name lexer in
 362     let parser = with_lexer parser lexer in
 363     (parser, token)
 364
 365   let require_xhp_name parser =
 366     if is_next_name parser then
 367       let (parser, token) = next_xhp_name parser in
 368       Make.token parser token
 369     else
 370       (* ERROR RECOVERY: Create a missing token for the expected token,
 371          and continue on from the current token. Don't skip it. *)
 372       (* TODO: Different error? *)
 373       let parser = with_error parser SyntaxError.error1004 in
 374       Make.missing parser (pos parser)
 375
 376   let is_next_xhp_category_name parser =
 377     Lexer.is_next_xhp_category_name (lexer parser)
 378
 379   (* Also returns whether last token was '\' *)
 380   let rec scan_qualified_name_worker parser name_opt acc is_backslash =
 381     let parser1, token = next_token_as_name parser in
 382     match name_opt, Token.kind token, acc with
 383     | Some name, TokenKind.Backslash, _ ->
 384       (* found backslash, create item and recurse *)
 385       let (parser, token) = Make.token parser1 token in
 386       let (parser, part) = Make.list_item parser name token in
 387       (* TODO(T25649779) *)
 388       scan_qualified_name_worker parser None (part :: acc) true
 389     | None, TokenKind.Name, _ ->
 390       (* found a name, recurse to look for backslash *)
 391       let (parser, token) = Make.token parser1 token in
 392       scan_qualified_name_worker parser (Some token) acc false
 393     | Some name, _, [] ->
 394       (* have not found anything - return [] to indicate failure *)
 395       parser, [], false
 396     | Some name, _, _ ->
 397       (* next token is not part of qualified name but we've consume some
 398          part of the input - create part for name with missing backslash
 399          and return accumulated result *)
 400       let (parser, missing) = Make.missing parser (pos parser) in
 401       let (parser, part) = Make.list_item parser name missing in
 402       (* TODO(T25649779) *)
 403       parser, List.rev (part :: acc), false
 404     | _ ->
 405       (* next token is not part of qualified name - return accumulated result *)
 406       parser, List.rev acc, is_backslash
 407
 408   let scan_remaining_qualified_name_extended parser name_token =
 409     let (parser, parts, is_backslash) =
 410       scan_qualified_name_worker parser (Some name_token) [] false
 411     in
 412     match parts with
 413     | [] ->
 414       (parser, name_token, is_backslash)
 415     | parts ->
 416       let (parser, list_node) = make_list parser parts in
 417       let (parser, name) = Make.qualified_name parser list_node in
 418       (parser, name, is_backslash)
 419
 420   let scan_remaining_qualified_name parser name_token =
 421     let (parser, name, _) =
 422       scan_remaining_qualified_name_extended parser name_token
 423     in
 424     (parser, name)
 425
 426   let scan_qualified_name_extended parser missing backslash =
 427     let (parser, head) = Make.list_item parser missing backslash in
 428     let (parser, parts, is_backslash) =
 429       scan_qualified_name_worker parser None [head] false
 430     in
 431     let (parser, list_node) = make_list parser parts in
 432     let (parser, name) = Make.qualified_name parser list_node in
 433     (parser, name, is_backslash)
 434
 435   let scan_qualified_name parser missing backslash =
 436     let (parser, name, _) =
 437       scan_qualified_name_extended parser missing backslash
 438     in
 439     (parser, name)
 440
 441   let scan_name_or_qualified_name parser =
 442     let parser1, token = next_token_as_name parser in
 443     match Token.kind token with
 444     | TokenKind.Name ->
 445       let (parser, token) = Make.token parser1 token in
 446       scan_remaining_qualified_name parser token
 447     | TokenKind.Backslash ->
 448       let (parser, missing) = Make.missing parser1 (pos parser1) in
 449       let (parser, token) = Make.token parser token in
 450       scan_qualified_name parser missing token
 451     | _ -> Make.missing parser (pos parser)
 452
 453   let next_xhp_class_name_or_other_token parser =
 454     if is_next_xhp_class_name parser then next_xhp_class_name parser
 455     else next_token parser
 456
 457   let next_xhp_class_name_or_other parser =
 458     let parser, token = next_xhp_class_name_or_other_token parser in
 459     match Token.kind token with
 460     | TokenKind.Name ->
 461       let (parser, name_token) = Make.token parser token in
 462       scan_remaining_qualified_name parser name_token
 463     | TokenKind.Backslash ->
 464       let (parser, missing) = Make.missing parser (pos parser) in
 465       let (parser, backslash) = Make.token parser token in
 466       scan_qualified_name parser missing backslash
 467     | _ -> Make.token parser token
 468
 469   let next_xhp_children_name_or_other parser =
 470     if is_next_xhp_category_name parser then
 471       let parser, token = next_xhp_category_name parser in
 472       parser, token
 473     else
 474       next_xhp_class_name_or_other_token parser
 475
 476   (* We accept either a Name or a QualifiedName token when looking for a
 477      qualified name. *)
 478   let require_qualified_name parser =
 479     let (parser1, name) = next_token_as_name parser in
 480     match Token.kind name with
 481     | TokenKind.Name ->
 482       let (parser, token) = Make.token parser1 name in
 483       scan_remaining_qualified_name parser token
 484     | TokenKind.Backslash ->
 485       let (parser, missing) = Make.missing parser1 (pos parser1) in
 486       let (parser, backslash) = Make.token parser name in
 487       scan_qualified_name parser missing backslash
 488     | _ ->
 489       let parser = with_error parser SyntaxError.error1004 in
 490       Make.missing parser (pos parser)
 491
 492   (**
 493    * TODO: If using qualified names for class names is legal in some cases, then
 494    * we need to update the specification accordingly.
 495    *
 496    * TODO: if we need the use of qualified names to be an error in some cases,
 497    * we need to add error checking code in a later pass.
 498    *)
 499   let require_class_name parser =
 500     if is_next_xhp_class_name parser then
 501       let (parser, token) = next_xhp_class_name parser in
 502       Make.token parser token
 503     else
 504       require_qualified_name parser
 505
 506   let require_function parser =
 507     require_token parser TokenKind.Function SyntaxError.error1003
 508
 509   let require_variable parser =
 510     require_token parser TokenKind.Variable SyntaxError.error1008
 511
 512   let require_semicolon_token parser =
 513     (* TODO: Kill PHPism; no semicolon required right before ?> *)
 514     match peek_token_kind parser with
 515     | TokenKind.QuestionGreaterThan ->
 516       parser, None
 517     | _ -> require_and_return_token parser TokenKind.Semicolon SyntaxError.error1010
 518
 519   let require_semicolon parser =
 520     (* TODO: Kill PHPism; no semicolon required right before ?> *)
 521     match peek_token_kind parser with
 522     | TokenKind.QuestionGreaterThan -> Make.missing parser (pos parser)
 523     | _ -> require_token parser TokenKind.Semicolon SyntaxError.error1010
 524
 525   let require_colon parser =
 526     require_token parser TokenKind.Colon SyntaxError.error1020
 527
 528   let require_left_brace parser =
 529     require_token parser TokenKind.LeftBrace SyntaxError.error1034
 530
 531   let require_right_brace parser =
 532     require_token parser TokenKind.RightBrace SyntaxError.error1006
 533
 534   let require_left_paren parser =
 535     require_token parser TokenKind.LeftParen SyntaxError.error1019
 536
 537   let require_right_paren parser =
 538     require_token parser TokenKind.RightParen SyntaxError.error1011
 539
 540   let require_left_angle parser =
 541     require_token parser TokenKind.LessThan SyntaxError.error1021
 542
 543   let require_right_angle parser =
 544     require_token parser TokenKind.GreaterThan SyntaxError.error1013
 545
 546
 547   let require_right_bracket parser =
 548     require_token parser TokenKind.RightBracket SyntaxError.error1032
 549
 550   let require_equal parser =
 551     require_token parser TokenKind.Equal SyntaxError.error1036
 552
 553   let require_arrow parser =
 554     require_token parser TokenKind.EqualGreaterThan SyntaxError.error1028
 555
 556   let require_lambda_arrow parser =
 557     require_token parser TokenKind.EqualEqualGreaterThan SyntaxError.error1046
 558
 559   let require_as parser =
 560     require_token parser TokenKind.As SyntaxError.error1023
 561
 562   let require_while parser =
 563     require_token parser TokenKind.While SyntaxError.error1018
 564
 565
 566   let require_coloncolon parser =
 567     require_token parser TokenKind.ColonColon SyntaxError.error1047
 568
 569   let require_name_or_variable_or_error parser error =
 570     let (parser1, token) = next_token_as_name parser in
 571     match Token.kind token with
 572     | TokenKind.Name ->
 573       let (parser, token) = Make.token parser1 token in
 574       scan_remaining_qualified_name parser token
 575     | TokenKind.Variable -> Make.token parser1 token
 576     | _ ->
 577       (* ERROR RECOVERY: Create a missing token for the expected token,
 578          and continue on from the current token. Don't skip it. *)
 579       let parser = with_error parser error in
 580       Make.missing parser (pos parser)
 581
 582   let require_name_or_variable parser =
 583     require_name_or_variable_or_error parser SyntaxError.error1050
 584
 585   let require_xhp_class_name_or_name_or_variable parser =
 586     if is_next_xhp_class_name parser then
 587       let (parser, token) = next_xhp_class_name parser in
 588       Make.token parser token
 589     else
 590       require_name_or_variable parser
 591
 592   let optional_token parser kind =
 593     let (parser1, token) = next_token parser in
 594     if (Token.kind token) = kind then
 595       Make.token parser1 token
 596     else
 597       Make.missing parser (pos parser)
 598
 599   let assert_token parser kind =
 600     let (parser, token) = next_token parser in
 601     let lexer = lexer parser in
 602     let source = Lexer.source lexer in
 603     let file_path = SourceText.file_path source in
 604     if (Token.kind token) <> kind then
 605       failwith (Printf.sprintf "Expected token '%s' but got '%s'\n  in %s\n"
 606         (TokenKind.to_string kind)
 607         (TokenKind.to_string (Token.kind token))
 608         (Relative_path.to_absolute file_path));
 609     Make.token parser token
 610
 611   type separated_list_kind =
 612     | NoTrailing
 613     | TrailingAllowed
 614     | ItemsOptional
 615
 616   (* This helper method parses a list of the form
 617
 618     open_token item separator_token item ... close_token
 619
 620     * We assume that open_token has already been consumed.
 621     * We do not consume the close_token.
 622     * The given error will be produced if an expected item is missing.
 623     * The caller is responsible for producing an error if the close_token
 624       is missing.
 625     * We expect at least one item.
 626     * If the list of items is empty then a Missing node is returned.
 627     * If the list of items is a singleton then the item is returned.
 628     * Otherwise, a list of the form (item, separator) ... item is returned.
 629   *)
 630
 631   let parse_separated_list_predicate parser separator_kind list_kind
 632       close_predicate error parse_item =
 633     let rec aux parser acc =
 634       (* At this point we are expecting an item followed by a separator,
 635          a close, or, if trailing separators are allowed, both *)
 636       let (parser1, token) = next_token parser in
 637       let kind = Token.kind token in
 638       if close_predicate kind || kind = TokenKind.EndOfFile then
 639         (* ERROR RECOVERY: We expected an item but we found a close or
 640            the end of the file. Make the item and separator both
 641            "missing" and give an error.
 642
 643            If items are optional and we found a close, the last item was
 644            omitted and there was no error. *)
 645         let parser = if kind = TokenKind.EndOfFile || list_kind <> ItemsOptional
 646           then with_error parser error
 647           else parser
 648         in
 649         let (parser, missing1) = Make.missing parser (pos parser) in
 650         let (parser, missing2) = Make.missing parser (pos parser) in
 651         let (parser, list_item) = Make.list_item parser missing1 missing2 in
 652         (* TODO(T25649779) *)
 653         (parser, (list_item :: acc))
 654       else if kind = separator_kind then
 655
 656         (* ERROR RECOVERY: We expected an item but we got a separator.
 657            Assume the item was missing, eat the separator, and move on.
 658
 659            If items are optional, there was no error, so eat the separator and
 660            continue.
 661
 662            TODO: This could be poor recovery. For example:
 663
 664                 function bar (Foo< , int blah)
 665
 666           Plainly the type arg is missing, but the comma is not associated with
 667           the type argument list, it's associated with the formal
 668           parameter list.  *)
 669
 670         let parser = if list_kind <> ItemsOptional
 671           then with_error parser1 error
 672           else parser1 in
 673         let (parser, item) = Make.missing parser (pos parser) in
 674         let (parser, separator) = Make.token parser token in
 675         let (parser, list_item) = Make.list_item parser item separator in
 676         (* TODO(T25649779) *)
 677         aux parser (list_item :: acc)
 678       else
 679
 680         (* We got neither a close nor a separator; hopefully we're going
 681            to parse an item followed by a close or separator. *)
 682         let (parser, item) = parse_item parser in
 683         let (parser1, token) = next_token parser in
 684         let kind = Token.kind token in
 685         if close_predicate kind then
 686           let (parser, missing) = Make.missing parser (pos parser) in
 687           let (parser, list_item) = Make.list_item parser item missing in
 688           (* TODO(T25649779) *)
 689           (parser, (list_item :: acc))
 690         else if kind = separator_kind then
 691           let (parser, separator) = Make.token parser1 token in
 692           let (parser, list_item) = Make.list_item parser item separator in
 693           (* TODO(T25649779) *)
 694           let acc = list_item :: acc in
 695           let allow_trailing = list_kind <> NoTrailing in
 696           (* We got an item followed by a separator; what if the thing
 697              that comes next is a close? *)
 698           if allow_trailing && close_predicate (peek_token_kind parser) then
 699             (parser, acc)
 700           else
 701             aux parser acc
 702         else
 703           (* ERROR RECOVERY: We were expecting a close or separator, but
 704              got neither. Bail out. Caller will give an error. *)
 705           let (parser, missing) = Make.missing parser (pos parser) in
 706           let (parser, list_item) = Make.list_item parser item missing in
 707           (* TODO(T25649779) *)
 708           (parser, (list_item :: acc)) in
 709     let (parser, items) = aux parser [] in
 710     let no_arg_is_missing = List.for_all (fun c -> not (SC.is_missing c)) items in
 711     let (parser, item_list) = make_list parser (List.rev items) in
 712     parser, item_list, no_arg_is_missing
 713
 714   let parse_separated_list parser separator_kind list_kind
 715       close_kind error parse_item =
 716     parse_separated_list_predicate
 717       parser
 718       separator_kind
 719       list_kind
 720       ((=) close_kind)
 721       error
 722       parse_item
 723
 724   let parse_separated_list_opt_predicate
 725       parser separator_kind allow_trailing close_predicate error parse_item =
 726     let token = peek_token parser in
 727     let kind = Token.kind token in
 728     if close_predicate kind then
 729       Make.missing parser (pos parser)
 730     else
 731       let (parser, items, _) =
 732       parse_separated_list_predicate
 733         parser
 734         separator_kind
 735         allow_trailing
 736         close_predicate
 737         error
 738         parse_item
 739       in
 740       (parser, items)
 741
 742   let parse_separated_list_opt
 743       parser separator_kind allow_trailing close_kind error parse_item =
 744     parse_separated_list_opt_predicate
 745       parser
 746       separator_kind
 747       allow_trailing
 748       ((=) close_kind)
 749       error
 750       parse_item
 751
 752   let parse_comma_list parser close_kind error parse_item =
 753     let (parser, items, _) =
 754       parse_separated_list
 755         parser
 756         TokenKind.Comma
 757         NoTrailing
 758         close_kind
 759         error
 760         parse_item
 761     in
 762     (parser, items)
 763
 764   let parse_comma_list_allow_trailing parser =
 765     parse_separated_list parser TokenKind.Comma TrailingAllowed
 766
 767   let parse_comma_list_opt parser =
 768     parse_separated_list_opt parser TokenKind.Comma NoTrailing
 769
 770   let parse_comma_list_opt_allow_trailing_predicate parser =
 771     parse_separated_list_opt_predicate parser TokenKind.Comma TrailingAllowed
 772
 773   let parse_comma_list_opt_allow_trailing parser =
 774     parse_separated_list_opt parser TokenKind.Comma TrailingAllowed
 775
 776   let parse_comma_list_opt_items_opt parser =
 777     parse_separated_list_opt parser TokenKind.Comma ItemsOptional
 778
 779   let parse_delimited_list
 780       parser left_kind left_error right_kind right_error parse_items =
 781     let (parser, left) = require_token parser left_kind left_error in
 782     let (parser, items) = parse_items parser in
 783     let (parser, right) = require_token parser right_kind right_error in
 784     (parser, left, items, right)
 785
 786   let parse_parenthesized_list parser parse_items =
 787     parse_delimited_list parser TokenKind.LeftParen SyntaxError.error1019
 788       TokenKind.RightParen SyntaxError.error1011 parse_items
 789
 790   let parse_parenthesized_comma_list parser parse_item =
 791     let parse_items parser =
 792       parse_comma_list
 793         parser TokenKind.RightParen SyntaxError.error1011 parse_item in
 794     parse_parenthesized_list parser parse_items
 795
 796   let parse_parenthesized_comma_list_opt_allow_trailing parser parse_item =
 797     let parse_items parser =
 798       parse_comma_list_opt_allow_trailing
 799         parser TokenKind.RightParen SyntaxError.error1011 parse_item in
 800     parse_parenthesized_list parser parse_items
 801
 802   let parse_parenthesized_comma_list_opt_items_opt parser parse_item =
 803     let parse_items parser =
 804       parse_comma_list_opt_items_opt
 805         parser TokenKind.RightParen SyntaxError.error1011 parse_item in
 806     parse_parenthesized_list parser parse_items
 807
 808   let parse_braced_list parser parse_items =
 809     parse_delimited_list parser TokenKind.LeftBrace SyntaxError.error1034
 810       TokenKind.RightBrace SyntaxError.error1006 parse_items
 811
 812   let parse_braced_comma_list_opt_allow_trailing parser parse_item =
 813     let parse_items parser =
 814       parse_comma_list_opt_allow_trailing
 815         parser TokenKind.RightBrace SyntaxError.error1006 parse_item in
 816     parse_braced_list parser parse_items
 817
 818   let parse_bracketted_list parser parse_items =
 819     parse_delimited_list parser TokenKind.LeftBracket SyntaxError.error1026
 820       TokenKind.RightBracket SyntaxError.error1031 parse_items
 821
 822   let parse_bracketted_comma_list_opt_allow_trailing parser parse_item =
 823     let parse_items parser =
 824       parse_comma_list_opt_allow_trailing
 825         parser TokenKind.RightBracket SyntaxError.error1031 parse_item in
 826     parse_bracketted_list parser parse_items
 827
 828   let parse_double_angled_list parser parse_items =
 829     parse_delimited_list parser TokenKind.LessThanLessThan SyntaxError.error1029
 830       TokenKind.GreaterThanGreaterThan SyntaxError.error1029 parse_items
 831
 832   let parse_double_angled_comma_list_allow_trailing parser parse_item =
 833     let parse_items parser =
 834       let (parser, items, _) =
 835         parse_comma_list_allow_trailing
 836           parser
 837           TokenKind.GreaterThanGreaterThan
 838           SyntaxError.error1029
 839           parse_item
 840       in
 841       (parser, items)
 842     in
 843     parse_double_angled_list parser parse_items
 844
 845   (* Parse with parse_item while a condition is met. *)
 846   let parse_list_while parser (parse_item : Parser.t -> Parser.t * Parser.SC.r) predicate =
 847     let rec aux parser acc =
 848       if peek_token_kind parser = TokenKind.EndOfFile ||
 849         not (predicate parser)
 850       then
 851         (parser, acc)
 852       else
 853         let (parser, result) = parse_item parser in
 854         (* ERROR RECOVERY: If the item is was parsed as 'missing', then it means
 855          * the parser bailed out of that scope. So, pass on whatever's been
 856          * accumulated so far, but with a 'Missing' SyntaxNode prepended. *)
 857         if SC.is_missing result
 858         then (parser, result :: acc )
 859         else aux parser (result :: acc) (* Or if nothing's wrong, recurse. *)
 860     in
 861     let (parser, items) = aux parser [] in
 862     make_list parser (List.rev items)
 863
 864   let parse_terminated_list parser parse_item terminator =
 865     let predicate parser = peek_token_kind parser != terminator in
 866     parse_list_while parser parse_item predicate
 867
 868   let parse_alternate_if_block parser parse_item =
 869     let parser1, block = parse_list_while parser parse_item (fun parser ->
 870       match peek_token_kind parser with
 871       | TokenKind.Elseif | TokenKind.Else | TokenKind.Endif -> false
 872       | _ -> true) in
 873     if SC.is_missing block
 874     then
 875       let parser, empty = Make.missing parser (pos parser) in
 876       let parser, es = Make.expression_statement parser empty empty in
 877       make_list parser [es]
 878     else
 879       parser1, block
 880
 881   let parse_list_until_none parser parse_item =
 882     let rec aux parser acc =
 883       let (parser, maybe_item) = parse_item parser in
 884       match maybe_item with
 885       | None -> (parser, acc)
 886       | Some item when peek_token_kind parser = TokenKind.EndOfFile ->
 887         parser, item :: acc
 888       | Some item -> aux parser (item :: acc)
 889     in
 890     let (parser, items) = aux parser [] in
 891     make_list parser (List.rev items)
 892
 893 end (* WithParser *)
 894 end (* WithLexer *)
 895 end (* WithSyntax *)