fancy-parser.mly 24.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
/******************************************************************************/
/*                                                                            */
/*                                   Menhir                                   */
/*                                                                            */
/*                       François Pottier, Inria Paris                        */
/*              Yann Régis-Gianas, PPS, Université Paris Diderot              */
/*                                                                            */
/*  Copyright Inria. All rights reserved. This file is distributed under the  */
/*  terms of the GNU General Public License version 2, as described in the    */
/*  file LICENSE.                                                             */
/*                                                                            */
/******************************************************************************/

14 15 16
/* This is the fancy version of the parser, to be processed by menhir.
   It is kept in sync with [Parser], but exercises menhir's features. */

17 18 19 20
/* As of 2014/12/02, the $previouserror keyword and the --error-recovery
   mode no longer exists. Thus, we replace all calls to [Error.signal]
   with calls to [Error.error], and report just one error. */

21 22 23 24 25
/* ------------------------------------------------------------------------- */
/* Imports. */

%{

POTTIER Francois's avatar
POTTIER Francois committed
26
open Stretch
27 28 29
open Syntax
open Positions

POTTIER Francois's avatar
POTTIER Francois committed
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
(* An injection of symbol expressions into choice expressions. *)

let inject (e : symbol_expression located) : expression =
  Positions.pmap (fun pos e ->
    let branch =
      Branch (
          Positions.with_pos pos (ESingleton e),
          ParserAux.new_production_level()
      )
    in
    EChoice [ branch ]
  ) e

(* When a stretch has been created by [Lexer.mk_stretch] with [parenthesize]
   set to [true], it includes parentheses. In some (rare) cases, this is
   undesirable. The following function removes the parentheses a posteriori.
   They are replaced with whitespace, so as to not alter column numbers. *)

let rec find s n i =
  assert (i < n);
  if s.[i] = '(' then i
  else begin
    assert (s.[i] = ' ');
    find s n (i+1)
  end

let unparenthesize (s : string) : string =
  let n = String.length s in
  (* The string [s] must end with a closing parenthesis. *)
  assert (n >= 2 && s.[n-1] = ')');
  (* The string [s] must begin with a certain amount of spaces
     followed with an opening parenthesis. Find its offset [i]. *)
  let i = find s n 0 in
  (* Create a copy without the parentheses. *)
  let b = Bytes.of_string s in
  Bytes.set b i ' ';
  Bytes.set b (n-1) ' ';
  Bytes.to_string b

let unparenthesize (s : Stretch.t) : Stretch.t =
  { s with stretch_content = unparenthesize s.stretch_content }

72 73 74
let unparenthesize (o : Stretch.t option) : Stretch.t option =
  Option.map unparenthesize o

75 76 77 78 79 80
%}

/* ------------------------------------------------------------------------- */
/* Tokens. */

%token TOKEN TYPE LEFT RIGHT NONASSOC START PREC PUBLIC COLON BAR EOF EQUAL
81
%token INLINE LPAREN RPAREN COMMA QUESTION STAR PLUS PARAMETER ON_ERROR_REDUCE
82
%token PERCENTATTRIBUTE SEMI
83
%token <string Positions.located> LID UID QID
84 85
%token <Stretch.t> HEADER
%token <Stretch.ocamltype> OCAMLTYPE
86
%token <Stretch.t Lazy.t> PERCENTPERCENT
POTTIER Francois's avatar
POTTIER Francois committed
87
%token <Syntax.raw_action> ACTION
88
%token <Syntax.attribute> ATTRIBUTE GRAMMARATTRIBUTE
POTTIER Francois's avatar
POTTIER Francois committed
89 90
/* For the new rule syntax: */
%token LET TILDE UNDERSCORE COLONEQUAL EQUALEQUAL
91 92

/* ------------------------------------------------------------------------- */
93
/* Type annotations and start symbol. */
94

95 96
%type <ParserAux.early_producer> producer
%type <ParserAux.early_production> production
97
%start <Syntax.partial_grammar> grammar
98 99 100 101

/* ------------------------------------------------------------------------- */
/* Priorities. */

POTTIER Francois's avatar
POTTIER Francois committed
102 103 104 105 106 107
/* These declarations solve a shift-reduce conflict in favor of shifting: when
   the right-hand side of an old-style rule begins with a leading bar, this
   bar is understood as an (insignificant) leading optional bar, *not* as an
   empty right-hand side followed by a bar. This ambiguity arises due to the
   possibility for several productions to share a single semantic action.
   The new rule syntax does not have this possibility, and has no ambiguity. */
108 109 110 111

%nonassoc no_optional_bar
%nonassoc BAR

POTTIER Francois's avatar
POTTIER Francois committed
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
/* ------------------------------------------------------------------------- */
/* On-error-reduce declarations. */

/* These declarations reduce the number of states where an error can occur,
   thus reduce the number of syntax error messages that we have to write in
   parserMessages.messages. */

%on_error_reduce old_rule
%on_error_reduce list(ATTRIBUTE)
%on_error_reduce action_expression
%on_error_reduce separated_nonempty_list(COMMA,symbol)
%on_error_reduce separated_nonempty_list(COMMA,pattern)
%on_error_reduce loption(delimited(LPAREN,separated_nonempty_list(COMMA,lax_actual),RPAREN))
%on_error_reduce loption(delimited(LPAREN,separated_nonempty_list(COMMA,expression),RPAREN))

127 128 129 130
%%

/* ------------------------------------------------------------------------- */
/* A grammar consists of declarations and rules, followed by an optional
131
   postlude, which we do not parse. */
132 133

grammar:
134 135
  ds = flatten(declaration*)
  PERCENTPERCENT
POTTIER Francois's avatar
POTTIER Francois committed
136
  rs = rule*
137
  t = postlude
138 139
    {
      {
140
        pg_filename          = ""; (* filled in by the caller *)
141
        pg_declarations      = ds;
142
        pg_rules             = rs;
143
        pg_postlude          = t
144 145 146 147
      }
    }

/* ------------------------------------------------------------------------- */
148
/* A declaration is an %{ OCaml header %}, or a %token, %start,
149 150 151 152 153
   %type, %left, %right, or %nonassoc declaration. */

declaration:

| h = HEADER /* lexically delimited by %{ ... %} */
154
    { [ with_loc $loc (DCode h) ] }
155

156 157 158 159
| TOKEN ty = OCAMLTYPE? ts = clist(terminal_alias_attrs)
    { List.map (Positions.map (fun (terminal, alias, attrs) ->
        DToken (ty, terminal, alias, attrs)
      )) ts }
160

161
| START t = OCAMLTYPE? nts = clist(nonterminal)
162 163 164 165
    /* %start <ocamltype> foo is syntactic sugar for %start foo %type <ocamltype> foo */
    {
      match t with
      | None ->
166
          List.map (Positions.map (fun nonterminal -> DStart nonterminal)) nts
167
      | Some t ->
168
          Misc.mapd (fun ntloc ->
169 170 171
            Positions.mapd (fun nt -> DStart nt, DType (t, ParameterVar ntloc)) ntloc) nts
    }

172
| TYPE t = OCAMLTYPE ss = clist(strict_actual)
173 174 175
    { List.map (Positions.map (fun nt -> DType (t, nt)))
        (List.map Parameters.with_pos ss) }

176
| k = priority_keyword ss = clist(symbol)
177
    { let prec = ParserAux.new_precedence_level $loc(k) in
178 179 180
      List.map (Positions.map (fun symbol -> DTokenProperties (symbol, k, prec))) ss }

| PARAMETER t = OCAMLTYPE
181
    { [ with_loc $loc (DParameter t) ] }
182

183
| attr = GRAMMARATTRIBUTE
184
    { [ with_loc $loc (DGrammarAttribute attr) ] }
185 186

| PERCENTATTRIBUTE actuals = clist(strict_actual) attrs = ATTRIBUTE+
187
    { [ with_loc $loc (DSymbolAttributes (actuals, attrs)) ] }
188

189
| ON_ERROR_REDUCE ss = clist(strict_actual)
190 191
    { let prec = ParserAux.new_on_error_reduce_level() in
      List.map (Positions.map (fun nt -> DOnErrorReduce (nt, prec)))
192 193
        (List.map Parameters.with_pos ss) }

194 195 196
| SEMI
    { [] }

197 198 199 200 201 202
/* This production recognizes tokens that are valid in the rules section,
   but not in the declarations section. This is a hint that a %% was
   forgotten. */

| rule_specific_token
    {
203
      Error.error [Positions.import $loc]
204
        "syntax error inside a declaration.\n\
POTTIER Francois's avatar
POTTIER Francois committed
205
         Did you perhaps forget the %%%% that separates declarations and rules?"
206 207
    }

208 209 210 211 212 213 214 215
priority_keyword:
  LEFT
    { LeftAssoc }
| RIGHT
    { RightAssoc }
| NONASSOC
    { NonAssoc }

216 217 218 219
%inline rule_specific_token:
| PUBLIC
| INLINE
| COLON
POTTIER Francois's avatar
POTTIER Francois committed
220
| LET
221 222 223
| EOF
    { () }

224 225 226 227 228 229 230 231 232
/* ------------------------------------------------------------------------- */
/* Our lists of symbols are separated with optional commas. Order is
   irrelevant. */

%inline clist(X):
  xs = separated_nonempty_list(COMMA?, X)
    { xs }

/* ------------------------------------------------------------------------- */
233 234 235 236 237 238 239 240 241 242
/* A symbol is a terminal or nonterminal symbol. */

/* One would like to require nonterminal symbols to begin with a lowercase
   letter, so as to lexically distinguish them from terminal symbols, which
   must begin with an uppercase letter. However, for compatibility with
   ocamlyacc, this is impossible. It can be required only for nonterminal
   symbols that are also start symbols. */

/* We also accept token aliases in place of ordinary terminal symbols.
   Token aliases are quoted strings. */
243 244 245 246

symbol:
  id = LID
| id = UID
247
| id = QID
248 249 250 251 252 253
    { id }

/* ------------------------------------------------------------------------- */
/* Terminals must begin with an uppercase letter. Nonterminals that are
   declared to be start symbols must begin with a lowercase letter. */

254 255 256 257 258 259 260
/* In declarations, terminals must be UIDs, but we may also declare
   token aliases, which are QIDs. */

%inline terminal_alias_attrs:
  id = UID alias = QID? attrs = ATTRIBUTE*
    { let alias = Option.map Positions.value alias in
      Positions.map (fun uid -> uid, alias, attrs) id }
261 262 263 264 265

%inline nonterminal:
  id = LID
    { id }

POTTIER Francois's avatar
POTTIER Francois committed
266 267 268 269 270 271 272 273 274 275 276
/* ------------------------------------------------------------------------- */
/* A rule is expressed either in the traditional (yacc-style) syntax or in
   the new syntax. */

%inline rule:
  old_rule
    { $1 }
| new_rule
    /* The new syntax is converted on the fly to the old syntax. */
    { NewRuleSyntax.rule $1 }

277 278 279 280 281
/* ------------------------------------------------------------------------- */
/* A rule defines a symbol. It is optionally declared %public, and optionally
   carries a number of formal parameters. The right-hand side of the definition
   consists of a list of productions. */

POTTIER Francois's avatar
POTTIER Francois committed
282 283 284
old_rule:
  flags = flags            /* flags */
  symbol = symbol          /* the symbol that is being defined */
285
  attributes = ATTRIBUTE*
POTTIER Francois's avatar
POTTIER Francois committed
286
  params = plist(symbol)   /* formal parameters */
287
  COLON
288
  optional_bar
289
  branches = branches
POTTIER Francois's avatar
POTTIER Francois committed
290
  SEMI*
291
    {
292
      let public, inline = flags in
293
      let rule = {
294 295
        pr_public_flag = public;
        pr_inline_flag = inline;
296 297
        pr_nt          = Positions.value symbol;
        pr_positions   = [ Positions.position symbol ];
298
        pr_attributes  = attributes;
299 300 301
        pr_parameters  = List.map Positions.value params;
        pr_branches    = branches
      }
POTTIER Francois's avatar
POTTIER Francois committed
302
      in rule
303 304
    }

305
%inline branches:
306
  prods = separated_nonempty_list(BAR, production_group)
307 308
    { List.flatten prods }

309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331
flags:
  /* epsilon */
    { false, false }
| PUBLIC
    { true, false }
| INLINE
    { false, true }
| PUBLIC INLINE
| INLINE PUBLIC
    { true, true }

optional_bar:
  /* epsilon */ %prec no_optional_bar
| BAR
    { () }

/* ------------------------------------------------------------------------- */
/* A production group consists of a list of productions, followed by a
   semantic action and an optional precedence specification. */

production_group:
  productions = separated_nonempty_list(BAR, production)
  action = ACTION
332
  oprec2 = ioption(precedence)
333
    {
334 335 336 337
      (* If multiple productions share a single semantic action, check
         that all of them bind the same names. *)
      ParserAux.check_production_group productions;
      (* Then, *)
338
      List.map (fun (producers, oprec1, level, pos) ->
339 340 341 342
        (* Replace [$i] with [_i]. *)
        let pr_producers = ParserAux.normalize_producers producers in
        (* Distribute the semantic action. Also, check that every [$i]
           is within bounds. *)
343 344
        let names = ParserAux.producer_names producers in
        let pr_action = action Settings.dollars names in
345 346 347 348 349 350 351
        {
          pr_producers;
          pr_action;
          pr_branch_prec_annotation   = ParserAux.override pos oprec1 oprec2;
          pr_branch_production_level  = level;
          pr_branch_position          = pos
        })
352
      productions
353 354
    }

POTTIER Francois's avatar
POTTIER Francois committed
355
precedence:
356 357 358 359 360 361 362 363
  PREC symbol = symbol
    { symbol }

/* ------------------------------------------------------------------------- */
/* A production is a list of producers, optionally followed by a
   precedence declaration. */

production:
364
  producers = producer* oprec = ioption(precedence)
365 366
    { producers,
      oprec,
367
      ParserAux.new_production_level(),
368
      Positions.import $loc
369 370 371 372
    }

/* ------------------------------------------------------------------------- */
/* A producer is an actual parameter, possibly preceded by a
373
   binding, and possibly followed with attributes.
374 375 376 377

   Because both [ioption] and [terminated] are defined as inlined by
   the standard library, this definition expands to two productions,
   one of which begins with id = LID, the other of which begins with
378
   p = actual. The token LID is in FIRST(actual),
379 380 381 382 383 384
   but the LR(1) formalism can deal with that. If [option] was used
   instead of [ioption], an LR(1) conflict would arise -- looking
   ahead at LID would not allow determining whether to reduce an
   empty [option] or to shift. */

producer:
385
| id = ioption(terminated(LID, EQUAL)) p = actual attrs = ATTRIBUTE* SEMI*
386
    { position (with_loc $loc ()), id, p, attrs }
387 388

/* ------------------------------------------------------------------------- */
389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412
/* The ideal syntax of actual parameters includes:
   1. a symbol, optionally applied to a list of actual parameters;
   2. an actual parameter followed with a modifier;
   3. an anonymous rule. (Not delimited by parentheses! Otherwise
      one would often end up writing two pairs of parentheses.) */

/* In order to avoid a few ambiguities, we restrict this ideal syntax as
   follows:
   a. Within a %type declaration, we use [strict_actual], which
      allows 1- and 2- (this is undocumented; the documentation says we
      require a symbol) but not 3-, which would not make semantic sense
      anyway.
   b. Within a producer, we use [actual], which allows 1- and
      2- but not 3-. Case 3- is allowed by switching to [lax_actual]
      within the actual arguments of an application, which are clearly
      delimited by parentheses and commas.
   c. In front of a modifier, we can never allow [lax_actual],
      as this would create an ambiguity: basically, [A | B?] could be
      interpreted either as [(A | B)?] or as [A | (B?)].
*/

%inline generic_actual(A, B):
(* 1- *)
  symbol = symbol actuals = plist(A)
413
    { Parameters.app symbol actuals }
414
(* 2- *)
415
| p = B m = located(modifier)
416
    { ParameterApp (m, [ p ]) }
417

418 419 420 421 422 423 424 425 426 427 428 429 430
strict_actual:
  p = generic_actual(strict_actual, strict_actual)
    { p }

actual:
  p = generic_actual(lax_actual, actual)
    { p }

lax_actual:
  p = generic_actual(lax_actual, /* cannot be lax_ */ actual)
    { p }
(* 3- *)
| /* leading bar disallowed */
431 432
  branches = located(branches)
    { ParameterAnonymous branches }
433 434 435 436 437 438
    (* 2016/05/18: we used to eliminate anonymous rules on the fly during
       parsing. However, when an anonymous rule appears in a parameterized
       definition, the fresh nonterminal symbol that is created should be
       parameterized. This was not done, and is not easy to do on the fly,
       as it requires inherited attributes (or a way of simulating them).
       We now use explicit abstract syntax for anonymous rules. *)
439

440 441 442 443 444 445
/* ------------------------------------------------------------------------- */
/* The "?", "+", and "*" modifiers are short-hands for applications of
   certain parameterized nonterminals, defined in the standard library. */

modifier:
  QUESTION
446
    { "option" }
447
| PLUS
448
    { "nonempty_list" }
449
| STAR
450
    { "list" }
451 452

/* ------------------------------------------------------------------------- */
453
/* A postlude is announced by %%, but is optional. */
454

455
postlude:
456 457
  EOF
    { None }
458
| p = PERCENTPERCENT /* followed by actual postlude */
459 460
    { Some (Lazy.force p) }

461
/* -------------------------------------------------------------------------- */
POTTIER Francois's avatar
POTTIER Francois committed
462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628
/* -------------------------------------------------------------------------- */

/* The new rule syntax. */

/* Whereas the old rule syntax allows a nonterminal symbol to begin with an
   uppercase letter, the new rule syntax disallows it. The left-hand side of a
   new rule must be a lowercase identifier [LID]. */

/* A new rule *cannot* be terminated by a semicolon. (This is contrast with a
   traditional rule, which can be followed with any number of semicolons.) We
   are forced to forbid the use of semicolons are as a rule terminator because
   they are used already as a sequencing construct. Permitting both uses would
   give rise to a shift/reduce conflict that we would not be able to solve. */

new_rule:
| rule_public     = boption(PUBLIC)
  LET
  rule_lhs        = LID
  rule_attributes = ATTRIBUTE*
  rule_formals    = plist(symbol)
  rule_inline     = equality_symbol
  rule_rhs        = expression
    {{
       rule_public;
       rule_inline;
       rule_lhs;
       rule_attributes;
       rule_formals;
       rule_rhs;
    }}

/* A new rule is written [let foo := ...] or [let foo == ...].
   In the former case, we get an ordinary nonterminal symbol;
   in the latter case, we get an %inline nonterminal symbol. */

equality_symbol:
  COLONEQUAL
    { false }
| EQUALEQUAL
    { true  }

/* The right-hand side of a new rule is an expression. */

/* An expression is a choice expression. */

expression:
  e = located(choice_expression)
    { e }

/* A choice expression is a bar-separated list of alternatives, with an
   optional leading bar, which is ignored. Each alternative is a sequence
   expression. */

/* We cannot allow a choice expression to be empty, even though that would
   make semantic sense (the empty sum is void). Indeed, that would create a
   shift/reduce conflict: after reading [def x = y], it would be unclear
   whether this is a definition of [x] as an alias for [y], or a definition of
   [x] as an alias for the empty sum, followed with an old-style rule that
   happens to begin with [y]. */

%inline choice_expression:
  branches = preceded_or_separated_nonempty_llist(BAR, branch)
    { EChoice branches }

%inline branch:
  e = seq_expression
    { Branch (e, ParserAux.new_production_level()) }

/* A sequence expression takes one of the following forms:

         e1; e2     a sequence that binds no variables (sugar for _ = e1; e2)
     p = e1; e2     a sequence that binds the variables in the pattern p

   or is an symbol expression or an action expression. */

/* Allowing an symbol expression [e] where a sequence expression is expected
   can be understood as syntactic sugar for [x = e; { x }]. */

/* In a sequence [e1; e2] or [p = e1; e2], the left-hand expression [e1] is
   *not* allowed to be an action expression. That would be a Bison-style
   midrule action. Instead, one must explicitly write [midrule({ ... })]. */

/* In a sequence, the semicolon cannot be omitted. This is in contrast with
   old-style rules, where semicolons are optional. Here, semicolons are
   required for disambiguation: indeed, in the absence of mandatory
   semicolons, when a sequence begins with x(y,z), it would be unclear whether
   1- x is a parameterized symbol and (y,z) are its actual arguments, or 2- x
   is unparameterized and (y, z) is a tuple pattern which forms the beginning
   of the next element of the sequence. */

/* We *could* allow the semicolon to be omitted when it precedes an action
   expression (as opposed to a sequence expression). This would be implemented
   in the definition of the nonterminal symbol [continuation]. We choose not
   to do this, as we wish to make it clear in this case that this is a
   sequence whose last element is the action expression. */

%inline seq_expression:
  e = located(raw_seq_expression)
    { e }

raw_seq_expression:
|                    e1 = symbol_expression e2 = continuation
    { ECons (SemPatWildcard, e1, e2) }
| p1 = pattern EQUAL e1 = symbol_expression e2 = continuation
    { ECons (p1, e1, e2) }
| e = symbol_expression
    { ESingleton e }
| e = action_expression
    { e }

%inline continuation:
  SEMI e2 = seq_expression
/* |   e2 = action_expression */
    { e2 }

/* A symbol expression takes one of the following forms:

     foo(...)       a terminal or nonterminal symbol (with parameters)
     e*             same as above
     e+             same as above
     e?             same as above */

/* Note the absence of parenthesized expressions [(e)] in the syntax of symbol
   expressions. There are two reasons why they are omitted. At the syntactic
   level, introducing them would create a conflict. At a semantic level, they
   are both unnecessary and ambiguous, as one can instead write [endrule(e)]
   or [midrule(e)] and thereby indicate whether the anonymous nonterminal
   symbol that is generated should or should not be marked %inline. */

symbol_expression:
| symbol = symbol es = plist(expression) attrs = ATTRIBUTE*
    { ESymbol (symbol, es, attrs) }
| e = located(symbol_expression) m = located(modifier) attrs = ATTRIBUTE*
    (* We are forced by syntactic considerations to require a symbol expression
       in a position where an expression is expected. As a result, an injection
       must be applied. *)
    { ESymbol (m, [ inject e ], attrs) }

/* An action expression is a semantic action, optionally preceded or followed
   with a precedence annotation. */

action_expression:
| action = action
    { EAction (action, None) }
| prec = precedence action = action
    { EAction (action, Some prec) }
| action = action prec = precedence
    { EAction (action, Some prec) }

/* A semantic action is either a traditional semantic action (an OCaml
   expression between curly braces) or a point-free semantic action (an
   optional OCaml identifier between angle brackets). */

/* The token OCAMLTYPE, which until now was supposed to denote an OCaml
   type between angle brackets, is re-used for this purpose. This is not
   very pretty. */

/* The stretch produced by the lexer is validated -- i.e., we check that
   it contains just an OCaml identifier, or is empty. The parentheses
   added by the lexer to the [stretch_content] field are removed (ugh!)
   because they are problematic when this identifier is a data constructor. */

action:
  action = ACTION
    { XATraditional action }
| action = OCAMLTYPE
    { match ParserAux.validate_pointfree_action action with
629 630 631
      | os ->
          XAPointFree (unparenthesize os)
      | exception Lexpointfree.InvalidPointFreeAction ->
POTTIER Francois's avatar
POTTIER Francois committed
632 633
          Error.error [Positions.import $loc]
            "A point-free semantic action must consist \
634
             of a single OCaml identifier." (* or whitespace *)
POTTIER Francois's avatar
POTTIER Francois committed
635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696
    }

/* Patterns. */

pattern:
| x = LID
    { SemPatVar x }
| UNDERSCORE
    { SemPatWildcard }
| TILDE
    { SemPatTilde (Positions.import $loc) }
| LPAREN ps = separated_list(COMMA, pattern) RPAREN
    { SemPatTuple ps }

(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)

(* Generic definitions. *)

(* ------------------------------------------------------------------------- *)

(* Formal and actual parameter lists can be absent. When present, they must
   be nonempty, and are delimited with parentheses and separated with commas. *)

%inline plist(X):
  params = loption(delimited(LPAREN, separated_nonempty_list(COMMA, X), RPAREN))
    { params }

(* -------------------------------------------------------------------------- *)

(* [reversed_preceded_or_separated_nonempty_llist(delimiter, X)] recognizes a
   nonempty list of [X]s, separated with [delimiter]s, and optionally preceded
   with a leading [delimiter]. It produces an OCaml list in reverse order. Its
   definition is left-recursive. *)

reversed_preceded_or_separated_nonempty_llist(delimiter, X):
| ioption(delimiter) x = X
    { [x] }
| xs = reversed_preceded_or_separated_nonempty_llist(delimiter, X)
  delimiter
  x = X
    { x :: xs }

(* [preceded_or_separated_nonempty_llist(delimiter, X)] recognizes a nonempty
   list of [X]s, separated with [delimiter]s, and optionally preceded with a
   leading [delimiter]. It produces an OCaml list in direct order. *)

%inline preceded_or_separated_nonempty_llist(delimiter, X):
  xs = rev(reversed_preceded_or_separated_nonempty_llist(delimiter, X))
    { xs }

(* [preceded_or_separated_llist(delimiter, X)] recognizes a possibly empty
   list of [X]s, separated with [delimiter]s, and optionally preceded with a
   leading [delimiter]. It produces an OCaml list in direct order. *)

preceded_or_separated_llist(delimiter, X):
| (* empty *)
    { [] }
| xs = preceded_or_separated_nonempty_llist(delimiter, X)
    { xs }

(* -------------------------------------------------------------------------- *)
697

POTTIER Francois's avatar
POTTIER Francois committed
698 699
(* [located(X)] recognizes the same language as [X] and converts the resulting
   value from type ['a] to type ['a located]. *)
700 701 702 703 704

located(X):
  x = X
    { with_loc $loc x }

705
%%