Commit 00d0d865 authored by POTTIER Francois's avatar POTTIER Francois

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

parent 8dd162e2
......@@ -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
......
......@@ -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
......
......@@ -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
......@@ -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
......@@ -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:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment