Commit fb23cffb authored by POTTIER Francois's avatar POTTIER Francois

Serious cleanup in [Action] and [NonTerminalDefinitionInlining].

parent ffea9880
open Keyword
type pkeywords =
keyword Positions.located list
type t = {
type t =
{
expr : IL.expr;
keywords : KeywordSet.t;
filenames : string list;
pkeywords : pkeywords
}
(* The code for this semantic action. *)
expr: IL.expr;
(* The files where this semantic action originates. Via inlining,
several semantic actions can be combined into one, so there can
be several files. *)
filenames: string list;
(* A list of keywords that appear in this semantic action, with their
positions. This list is maintained only up to the well-formedness check in
[PartialGrammar.check_keywords]. Thereafter, it is no longer used. So, the
keyword-renaming functions do not bother to update it. *)
pkeywords : keyword Positions.located list;
(* The set of keywords that appear in this semantic action. They can be thought
of as free variables that refer to positions. They must be renamed during
inlining. *)
keywords : KeywordSet.t;
}
(* Creation. *)
let pkeywords_to_keywords pkeywords =
KeywordSet.of_list (List.map Positions.value pkeywords)
......@@ -20,9 +34,11 @@ let from_stretch s =
expr = IL.ETextual s;
filenames = [ s.Stretch.stretch_filename ];
pkeywords = pkeywords;
keywords = pkeywords_to_keywords pkeywords; (* TEMPORARY maybe we do not need this redundancy? *)
keywords = pkeywords_to_keywords pkeywords;
}
(* Composition, used during inlining. *)
let compose x a1 a2 =
(* 2015/07/20: there used to be a call to [parenthesize_stretch] here,
which would insert parentheses around every stretch in [a1]. This is
......@@ -32,48 +48,52 @@ let compose x a1 a2 =
expr = IL.ELet ([ IL.PVar x, a1.expr ], a2.expr);
keywords = KeywordSet.union a1.keywords a2.keywords;
filenames = a1.filenames @ a2.filenames;
pkeywords = a1.pkeywords @ a2.pkeywords;
pkeywords = [] (* don't bother; already checked *)
}
(* Renaming of keywords, used during inlining. *)
type sw =
Keyword.subject * Keyword.where
type renaming_env =
type keyword_renaming =
string * sw * sw
let rename_inlined_psym ((psym, first_prod, last_prod) : renaming_env) phi pkeywords =
List.fold_left (fun (l, phi, (used1, used2)) pk ->
match Positions.value pk with
let rename_inlined_psym ((psym, first_prod, last_prod) : keyword_renaming) phi keywords =
let phi = ref phi in
let keywords =
KeywordSet.map (fun keyword ->
match keyword with
| Position (subject, where, flavor) ->
let (subject', where'), (used1, used2) =
let (subject', where') =
match subject, where with
| RightNamed s, w ->
(* In the host rule, $startpos(x) is changed
to $startpos(first_prod) (same thing for $endpos). *)
if s = psym then
match w with
| WhereStart -> first_prod, (true, used2)
| WhereEnd -> last_prod, (used1, true)
| WhereStart -> first_prod
| WhereEnd -> last_prod
else
(* Otherwise, we just take the renaming into account. *)
let s' = try
List.assoc s phi
List.assoc s !phi
with Not_found -> s
in
(RightNamed s', w), (used1, used2)
| Left, _ -> (subject, where), (used1, used2)
(RightNamed s', w)
| Left, _ -> (subject, where)
in
let from_pos = Keyword.posvar subject where flavor
and to_pos = Keyword.posvar subject' where' flavor in
(Positions.with_pos (Positions.position pk)
(Position (subject', where', flavor)) :: l,
(if from_pos <> to_pos && not (List.mem_assoc from_pos phi) then
(from_pos, to_pos) :: phi else phi),
(used1, used2))
if from_pos <> to_pos && not (List.mem_assoc from_pos !phi) then
phi := (from_pos, to_pos) :: !phi;
Position (subject', where', flavor)
| SyntaxError -> pk :: l, phi, (used1, used2)
| SyntaxError -> SyntaxError
)
([], phi, (false, false)) pkeywords
keywords
in
keywords, !phi
(* Rename the keywords related to position to handle the composition
of semantic actions during non terminal inlining.
......@@ -87,43 +107,45 @@ let rename_inlined_psym ((psym, first_prod, last_prod) : renaming_env) phi pkeyw
- [psym] is the producer that is being inlined.
*)
let rename_pkeywords (psym, first_prod, last_prod) phi l =
List.fold_left (fun (l, phi, (used1, used2)) pk -> match pk.Positions.value with
| Position (subject, where, flavor) ->
let (subject', where'), (used1, used2) =
let rename_pkeywords (psym, first_prod, last_prod) phi keywords =
let phi = ref phi in
let keywords =
KeywordSet.map (fun keyword ->
match keyword with
| Position (subject, where, flavor) ->
let (subject', where') =
match subject, where with
(* $startpos is changed to $startpos(first_prod) in the
inlined rule. *)
| Left, WhereStart -> first_prod, (true, used2)
| Left, WhereStart -> first_prod
(* Similarly for $endpos. *)
| Left, WhereEnd -> last_prod, (used1, true)
(* $i cannot be combined with inlining. *)
| Left, WhereEnd -> last_prod
| RightNamed s, w ->
(* In the host rule, $startpos(x) is changed to
to $startpos(first_prod) (same thing for $endpos). *)
if s = psym then
match w with
| WhereStart -> first_prod, (true, used2)
| WhereEnd -> last_prod, (used1, true)
| WhereStart -> first_prod;
| WhereEnd -> last_prod
else
(* Otherwise, we just that the renaming into account. *)
let s' = try List.assoc s phi with Not_found -> s in
(RightNamed s', w), (used1, used2)
(* Otherwise, we just take the renaming into account. *)
let s' = try List.assoc s !phi with Not_found -> s in
(RightNamed s', w)
in
let from_pos = Keyword.posvar subject where flavor
and to_pos = Keyword.posvar subject' where' flavor in
(Positions.with_pos pk.Positions.position
(Position (subject', where', flavor)) :: l,
(if from_pos <> to_pos && not (List.mem_assoc from_pos phi) then
(from_pos, to_pos) :: phi else phi),
(used1, used2))
| _ -> pk :: l, phi, (used1, used2))
if from_pos <> to_pos && not (List.mem_assoc from_pos !phi) then
phi := (from_pos, to_pos) :: !phi;
Position (subject', where', flavor)
([], phi, (false, false)) l
| SyntaxError -> SyntaxError
)
keywords
in
keywords, !phi
let rename renaming_fun renaming_env phi a =
let pkeywords, phi, used_fg = renaming_fun renaming_env phi a.pkeywords in
let rename renaming_fun keyword_renaming phi a =
let keywords, phi = renaming_fun keyword_renaming phi a.keywords in
{ a with
(* We use the let construct to rename without modification of the semantic
action code. *)
......@@ -132,9 +154,9 @@ let rename renaming_fun renaming_env phi a =
a.expr);
(* Keywords related to positions are updated too. *)
pkeywords = pkeywords;
keywords = pkeywords_to_keywords pkeywords;
}, used_fg
pkeywords = []; (* don't bother *)
keywords = keywords;
}
let rename_inlined_psym =
rename rename_inlined_psym
......
......@@ -10,23 +10,23 @@ val compose : string -> t -> t -> t
type sw =
Keyword.subject * Keyword.where
type renaming_env =
type keyword_renaming =
string * sw * sw
(** [rename renaming_env phi a] builds the action
(** [rename keyword_renaming phi a] builds the action
[let x1 = x1' and ... xn = xn' in a] if [phi] is [(x1, x1') ... (xn, xn')].
Moreover, [renaming_env] is used to correctly replace $startpos/$endpos
present in the semantic action. *)
val rename:
renaming_env
-> (string * string) list -> t -> t * (bool * bool)
keyword_renaming
-> (string * string) list -> t -> t
(** [rename_inlined_psym renaming_env phi a] updates the occurrences of the
(** [rename_inlined_psym keyword_renaming phi a] updates the occurrences of the
inlined non terminal in the action [a].
*)
val rename_inlined_psym:
renaming_env
-> (string * string) list -> t -> t * (bool * bool)
keyword_renaming
-> (string * string) list -> t -> t
(** Semantic actions are translated into [IL] code using the
[IL.ETextual] and [IL.ELet] constructors. *)
......
......@@ -110,42 +110,39 @@ let inline grammar =
let phi, inlined_producers = rename_if_necessary b pb.producers in
(* Define the renaming environment given the shape of the branch. *)
let renaming_env, prefix', suffix' =
let start_position, prefix' =
let start_position =
match List.rev prefix with
(* If the prefix is empty, the start position is the rule
start position. *)
| [] -> (Keyword.Left, Keyword.WhereStart), prefix
| [] -> (Keyword.Left, Keyword.WhereStart)
(* The last producer of prefix is named [x],
$startpos in the inlined rule will be changed to $endpos(x). *)
| (_, x) :: _ -> (Keyword.RightNamed x, Keyword.WhereEnd), prefix
| (_, x) :: _ -> (Keyword.RightNamed x, Keyword.WhereEnd)
in
(* Same thing for the suffix. *)
let end_position, suffix' =
let end_position =
match suffix with
| [] -> (Keyword.Left, Keyword.WhereEnd), suffix
| (_, x) :: _ -> (Keyword.RightNamed x, Keyword.WhereStart), suffix
| [] -> (Keyword.Left, Keyword.WhereEnd)
| (_, x) :: _ -> (Keyword.RightNamed x, Keyword.WhereStart)
in
(psym, start_position, end_position), prefix', suffix'
let renaming_env =
(psym, start_position, end_position)
in
(* Rename the host semantic action.
Each reference of the inlined non terminal [psym] must be taken into
account. $startpos(psym) is changed to $startpos(x) where [x] is
the first producer of the inlined branch if it is not empty or
the preceding producer found in the prefix. *)
let outer_action, (used1, used2) =
let outer_action =
Action.rename_inlined_psym renaming_env [] b.action
in
let action', (used1', used2') =
let action' =
Action.rename renaming_env phi pb.action
in
assert (prefix == prefix' && suffix == suffix');
let prefix = if used1 || used1' then prefix' else prefix in
let suffix = if used2 || used2' then suffix' else suffix in
{ b with
producers = prefix @ inlined_producers @ suffix;
......
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