Modified ParserAux and the parsers to avoid the dependency on Str.

src/_tags

@@ -11,9 +11,9 @@
 <checkOCamlVersion.byte>: use_str
 
 # Build and link with -g.
-<**/*.{cmo,cmx}>:debug, use_str
-<**/*.byte>:debug, use_str
-<**/*.native>:debug, use_str
+<**/*.{cmo,cmx}>:debug
+<**/*.byte>:debug
+<**/*.native>:debug
 
 # 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

@@ -269,16 +269,24 @@ production_group:
   action = ACTION
   oprec2 = precedence?
     {
-      ParserAux.normalize_production_group productions
-      |> List.map (fun (producers, oprec1, rprec, pos) ->
-  	let producer_names = ParserAux.producer_names producers in
+      (* If multiple productions share a single semantic action, check
+         that all of them bind the same names. *)
+      ParserAux.check_production_group productions;
+      (* Then, *)
+      List.map (fun (producers, oprec1, rprec, pos) ->
+        (* Replace [$i] with [_i]. *)
+        let pr_producers = ParserAux.normalize_producers producers in
+        (* Distribute the semantic action. Also, check that every [$i]
+           is within bounds. *)
+        let pr_action = action (ParserAux.producer_names producers) in
 	{
-	  pr_producers                = producers;
-	  pr_action                   = action producer_names;
+	  pr_producers;
+	  pr_action;
 	  pr_branch_shift_precedence  = ParserAux.override pos oprec1 oprec2;
 	  pr_branch_reduce_precedence = rprec;
 	  pr_branch_position          = pos
 	})
+      productions
     }
 | error ACTION precedence?
 | error EOF

src/parserAux.ml

@@ -46,8 +46,7 @@ let check_production_group right_hand_sides =
 	  with Not_found ->
 	    ()
 	  ) right_hand_sides
-  end;
-  right_hand_sides
+  end
 
 (* [normalize_producer i p] assigns a name of the form [_i]
    to the unnamed producer [p]. *)
@@ -59,13 +58,8 @@ let normalize_producer i (pos, opt_identifier, parameter) =
   in
   (id, parameter)
 
-let normalize_right_hand_side (producers, a, b, c) =
-  (List.mapi normalize_producer producers, a, b, c)
-
-let normalize_production_group right_hand_sides =
-  right_hand_sides
-  |> check_production_group
-  |> List.map normalize_right_hand_side
+let normalize_producers producers =
+  List.mapi normalize_producer producers
 
 let override pos o1 o2 =
   match o1, o2 with
@@ -113,17 +107,13 @@ let rules () =
   rules := [];
   result
 
-(* Only unnamed producers can be referred using positional identifiers.
+(* Only unnamed producers can be referred to 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
+   [p.(idx) = Some x] if [idx] must be referred to 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
-  )
+  producers
+  |> List.map (fun (_, oid, _) -> Option.map Positions.value oid)
+  |> Array.of_list
+

src/parserAux.mli

@@ -8,12 +8,21 @@ open Syntax
 val current_token_precedence: Lexing.position -> Lexing.position -> precedence_level
 val current_reduce_precedence: unit -> precedence_level
 
-(* [check_disjunctive_production] accepts production group and checks
-   that they all productions in the group define the same set of
-   identifiers. *)
+(* [check_production_group] accepts a production group and checks that all
+   productions in the group define the same set of identifiers. *)
 
-val normalize_production_group:
-  ((Positions.t * identifier Positions.located option * parameter) list * 'a * 'b * 'c) list -> (producer list * 'a * 'b * 'c) list
+val check_production_group:
+  ((Positions.t * identifier Positions.located option * parameter) list * 'a * 'b * 'c) list ->
+  unit
+
+(* [normalize_producers] accepts a list of producers where identifiers are
+   optional and returns a list of producers where identifiers are mandatory.
+   A missing identifier in the [i]-th position receives the conventional
+   name [_i]. *)
+
+val normalize_producers: 
+  (Positions.t * identifier Positions.located option * parameter) list ->
+  producer list
 
 (* [override pos oprec1 oprec2] decides which of the two optional
    %prec declarations [oprec1] and [oprec2] applies to a
@@ -33,4 +42,6 @@ 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
+val producer_names :
+  (_ * Syntax.identifier Positions.located option * _) list ->
+  Syntax.identifier option array

src/yacc-parser.mly

@@ -263,18 +263,24 @@ 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
-
+      (* If multiple productions share a single semantic action, check
+         that all of them bind the same names. *)
+      ParserAux.check_production_group productions;
+      (* Then, *)
       List.map (fun (producers, oprec1, rprec, pos) ->
-	let producer_names = ParserAux.producer_names producers in
+        (* Replace [$i] with [_i]. *)
+        let pr_producers = ParserAux.normalize_producers producers in
+        (* Distribute the semantic action. Also, check that every [$i]
+           is within bounds. *)
+        let pr_action = action (ParserAux.producer_names producers) in
 	{
-	  pr_producers                = producers;
-	  pr_action                   = action producer_names;
+	  pr_producers;
+	  pr_action;
 	  pr_branch_shift_precedence  = ParserAux.override pos oprec1 oprec2;
 	  pr_branch_reduce_precedence = rprec;
 	  pr_branch_position          = pos
-	}) productions
+	})
+      productions
     }
 
 optional_precedence: