- ParserAux.producer_names: New. Is the n-th producer anonymous or not?

  (Now uses the Str module.)

- Lexer.check_producers_indices: New. Are $i keywords correctly used?

- yacc-parser/fancy-parser: Turn the type of actions' semantic values
  into arrows to delay the checking of $i keywords from lexing to
  parsing.

src/_tags

@@ -11,9 +11,9 @@
 <checkOCamlVersion.byte>: use_str
 
 # Build and link with -g.
-<**/*.{cmo,cmx}>:debug
-<**/*.byte>:debug
-<**/*.native>:debug
+<**/*.{cmo,cmx}>:debug, use_str
+<**/*.byte>:debug, use_str
+<**/*.native>:debug, use_str
 
 # Every module that is part of MenhirLib must be tagged as such.
 # If you change this list, please also update the files LICENSE

src/fancy-parser.mly

@@ -25,7 +25,7 @@ open Positions
 %token <Stretch.t> HEADER
 %token <Stretch.ocamltype> OCAMLTYPE
 %token <Stretch.t Lazy.t> PERCENTPERCENT
-%token <Action.t> ACTION
+%token <Syntax.identifier option array -> Action.t> ACTION
 
 /* ------------------------------------------------------------------------- */
 /* Start symbol. */
@@ -268,15 +268,17 @@ production_group:
   productions = separated_nonempty_list(BAR, production)
   action = ACTION
   oprec2 = precedence?
-    { 
+    {
       ParserAux.normalize_production_group productions
-      |> List.map (fun (producers, oprec1, rprec, pos) -> {
-	pr_producers                = producers;
-	pr_action                   = action;
-	pr_branch_shift_precedence  = ParserAux.override pos oprec1 oprec2;
-	pr_branch_reduce_precedence = rprec;
-	pr_branch_position          = pos
-      }) 
+      |> List.map (fun (producers, oprec1, rprec, pos) ->
+  	let producer_names = ParserAux.producer_names producers in
+	{
+	  pr_producers                = producers;
+	  pr_action                   = action producer_names;
+	  pr_branch_shift_precedence  = ParserAux.override pos oprec1 oprec2;
+	  pr_branch_reduce_precedence = rprec;
+	  pr_branch_position          = pos
+	})
     }
 | error ACTION precedence?
 | error EOF

src/lexer.mll

@@ -13,7 +13,7 @@
     let token = f lexbuf in
     lexbuf.lex_start_p <- startp;
     token
-  
+
   (* Updates the line counter, which is used in some error messages. *)
 
   let update_loc lexbuf =
@@ -37,6 +37,26 @@
     assert (Bytes.get content offset = c1);
     Bytes.set content offset c2
 
+  (* Check that only allowed indices are used in semantic actions. *)
+  let check_producers_indices allowed_producers pkeywords =
+    List.iter (function
+      | { value = Keyword.PDollar idx; position } ->
+	if idx - 1 >= Array.length allowed_producers then
+	  Error.error [position] begin
+	    Printf.sprintf "$%d refers to a nonexistent symbol." idx
+	  end
+	else begin match allowed_producers.(idx - 1) with
+	    | None ->
+	      ()
+	    | Some x ->
+	      Error.error [position] begin
+		Printf.sprintf "please do not say: $%d. Instead, say: %s." idx x
+	      end
+	  end
+      | _ ->
+	()
+    ) pkeywords
+
   (* In-place transformation of keywords. We turn our keywords into
      valid OCaml identifiers by replacing '$', '(', and ')' with '_'.
      Bloody. *)
@@ -344,8 +364,12 @@ rule main = parse
     { savestart lexbuf (fun lexbuf ->
         let openingpos = lexeme_end_p lexbuf in
         let closingpos, pkeywords = action false openingpos [] lexbuf in
-	let stretch = mk_stretch openingpos closingpos true pkeywords in
-        ACTION (Action.from_stretch stretch)
+        ACTION (
+	  fun allowed_producers_indices ->
+	  let stretch = mk_stretch openingpos closingpos true pkeywords in
+	  check_producers_indices allowed_producers_indices pkeywords;
+	  Action.from_stretch stretch
+	)
       ) }
 | eof
     { EOF }

src/parserAux.ml

@@ -6,7 +6,7 @@ let current_token_precedence =
   fun pos1 pos2 ->
     incr c;
     PrecedenceLevel (Error.get_filemark (), !c, pos1, pos2)
-      
+
 let current_reduce_precedence =
   let c = ref 0 in
   fun () ->
@@ -113,3 +113,17 @@ let rules () =
   rules := [];
   result
 
+(* Only unamed producers can be referred using positional identifiers.
+   Besides, such positions must be taken in the interval [1
+   .. List.length producers]. The output array [p] is such that
+   [p.(idx) = Some x] if [idx] must be referred using [x], not
+   [$(idx + 1)]. *)
+let producer_names producers =
+  let is_index identifier =
+    Str.(string_match (regexp "_[0-9]+") identifier 0)
+  in
+  List.(
+    producers
+    |> map (fun ({ value = id }, _) -> if is_index id then None else Some id)
+    |> Array.of_list
+  )

src/parserAux.mli

@@ -29,3 +29,8 @@ val override: Positions.t -> 'a option -> 'a option -> 'a option
 
 val anonymous: Positions.t -> parameterized_branch list -> string
 val rules: unit -> parameterized_rule list
+
+(* [producer_names producers] returns an array [names] such that
+   [names.(idx) = None] if the (idx + 1)-th producer is unnamed
+   and [names.(idx) = Some id] if it is called [id]. *)
+val producer_names : Syntax.producer list -> Syntax.identifier option array

src/yacc-parser.mly

@@ -19,7 +19,7 @@ open Positions
 %token <Stretch.t> HEADER
 %token <Stretch.ocamltype> OCAMLTYPE
 %token <Stretch.t Lazy.t> PERCENTPERCENT
-%token <Syntax.action> ACTION
+%token <Syntax.identifier option array -> Syntax.action> ACTION
 %start grammar
 %type <ConcreteSyntax.grammar> grammar
 
@@ -261,18 +261,20 @@ production_groups:
 
 production_group:
   productions ACTION /* action is lexically delimited by braces */ optional_precedence
-    { 
+    {
       let productions, action, oprec2 = $1, $2, $3 in
 
       let productions = ParserAux.normalize_production_group productions in
 
-      List.map (fun (producers, oprec1, rprec, pos) -> {
-	pr_producers                = producers;
-	pr_action                   = action;
-	pr_branch_shift_precedence  = ParserAux.override pos oprec1 oprec2;
-	pr_branch_reduce_precedence = rprec;
-	pr_branch_position          = pos
-      }) productions
+      List.map (fun (producers, oprec1, rprec, pos) ->
+	let producer_names = ParserAux.producer_names producers in
+	{
+	  pr_producers                = producers;
+	  pr_action                   = action producer_names;
+	  pr_branch_shift_precedence  = ParserAux.override pos oprec1 oprec2;
+	  pr_branch_reduce_precedence = rprec;
+	  pr_branch_position          = pos
+	}) productions
     }
 
 optional_precedence: