Commit bd694516 authored by POTTIER Francois's avatar POTTIER Francois

Implement a more economical renaming scheme for semantic values

during the elimination of %inlined symbols.
parent f8437b40
......@@ -2,6 +2,11 @@
## 2018/10/31
* Implement a more economical renaming scheme for OCaml variables
during the elimination of `%inline` symbols. This leads to slightly
more readable code (more reasonable variables names, fewer `let`
bindings).
* Another attempt at removing all trailing spaces in auto-generated
`.messages` files. (I hope I got it right, this time.)
......
......@@ -91,14 +91,14 @@ let names (producers : producers) : StringSet.t =
that can be inlined. *)
let inline grammar =
(* This function returns a fresh name beginning with [prefix] and
that is not in the set of names [names]. *)
let rec fresh ?(c=0) names prefix =
let name = prefix^string_of_int c in
if StringSet.mem name names then
fresh ~c:(c+1) names prefix
else
name
(* This function returns a fresh name that begins with [prefix] (although
this is not essential!) and that is not in the set [names]. *)
let rec fresh names prefix =
if StringSet.mem prefix names then
let prefix = prefix ^ "'" in
fresh names prefix
else
prefix
in
let use_inline = ref false in
......@@ -153,26 +153,27 @@ let inline grammar =
let prefix, nt, p, psym, suffix = chop_inline ([], b.producers) in
prefix, expand_rule nt p, nt, psym, suffix
(* We have to rename producers' names of the inlined production
if they clash with the producers' names of the branch into
which we do the inlining. *)
(* We have to rename the producers [producers] of the inlined production
if they clash with the names of the producers of the host branch [b]. *)
and rename_if_necessary b producers =
(* First we compute the set of names already in use. *)
let producers_names = names (b.producers @ producers) in
(* Compute the set of the names already in use in the host branch. *)
let used = names b.producers in
(* Compute a renaming and the new inlined producers' names. *)
let phi, producers' =
List.fold_left (fun (phi, producers) producer ->
(* Compute a renaming and the new names of the inlined producers. *)
let phi, _used, producers' =
List.fold_left (fun (phi, used, producers) producer ->
let x = producer_identifier producer in
if StringSet.mem x producers_names then
let x' = fresh producers_names x in
((x, x') :: phi, { producer with producer_identifier = x' } :: producers)
if StringSet.mem x used then
let x' = fresh used x in
(x, x') :: phi,
StringSet.add x' used,
{ producer with producer_identifier = x' } :: producers
else
(phi, producer :: producers)
) ([], []) producers
(phi, used, producer :: producers)
) ([], used, []) producers
in
phi, List.rev producers'
phi, List.rev producers'
(* Inline the non terminals that can be inlined in [b]. We use the
ListMonad to combine the results. *)
......
......@@ -16,21 +16,19 @@ bar:
{ ( 2 )}
phrase:
x000 = foo x00 = foo _3 = EOF
x' = foo x'' = foo _3 = EOF
{let t =
let x0 = x00 in
let x' = x'' in
let x =
let x = x0 in
let x = x' in
( x )
in
( x )
in
let y =
let x00 = x000 in
let x =
let x0 = x00 in
let x =
let x = x0 in
let x = x' in
( x )
in
( x )
......@@ -38,15 +36,11 @@ let y =
( x )
in
( y + t )}
| x000 = foo z0000 = bar _3 = EOF
| x' = foo z = bar _3 = EOF
{let t =
let z000 = z0000 in
let x =
let z00 = z000 in
let _1 =
let z0 = z00 in
let x =
let z = z0 in
( z )
in
( x )
......@@ -56,11 +50,9 @@ in
( x )
in
let y =
let x00 = x000 in
let x =
let x0 = x00 in
let x =
let x = x0 in
let x = x' in
( x )
in
( x )
......@@ -68,21 +60,17 @@ let y =
( x )
in
( y + t )}
| z000 = bar x00 = foo _3 = EOF
| z = bar x' = foo _3 = EOF
{let t =
let x0 = x00 in
let x =
let x = x0 in
let x = x' in
( x )
in
( x )
in
let y =
let z00 = z000 in
let x =
let z0 = z00 in
let x =
let z = z0 in
( z )
in
( x )
......@@ -90,15 +78,12 @@ let y =
( x )
in
( y + t )}
| z000 = bar z0000 = bar _3 = EOF
| z = bar z' = bar _3 = EOF
{let t =
let z000 = z0000 in
let z = z' in
let x =
let z00 = z000 in
let _1 =
let z0 = z00 in
let x =
let z = z0 in
( z )
in
( x )
......@@ -108,11 +93,8 @@ in
( x )
in
let y =
let z00 = z000 in
let x =
let z0 = z00 in
let x =
let z = z0 in
( z )
in
( x )
......
......@@ -11,15 +11,13 @@
%%
midrule___anonymous_1_:
_10 = C
_1 = C
{let x =
let _1 = _10 in
()
in
( x )}
| _10 = D
| _1 = D
{let x =
let _1 = _10 in
()
in
( x )}
......@@ -27,29 +25,26 @@ in
list___anonymous_0_A_B__:
{ ( [] )}
| x0 = A xs = list___anonymous_0_A_B__
| x' = A xs = list___anonymous_0_A_B__
{let x =
let x = x0 in
let x = x' in
( Left x )
in
( x :: xs )}
| y0 = B xs = list___anonymous_0_A_B__
| y = B xs = list___anonymous_0_A_B__
{let x =
let y = y0 in
( Right y )
in
( x :: xs )}
phrase:
_10 = C _20 = list___anonymous_0_A_B__ _11 = D _21 = list___anonymous_0_A_B__ _3 = EOF
_1 = C _2 = list___anonymous_0_A_B__ _1' = D _2' = list___anonymous_0_A_B__ _3 = EOF
{let ys =
let _2 = _21 in
let _1 = _11 in
let _2 = _2' in
let _1 = _1' in
( _1 )
in
let xs =
let _2 = _20 in
let _1 = _10 in
( _1 )
in
( xs @ ys )}
......
......@@ -11,15 +11,14 @@
list___anonymous_0_A_B__:
{ ( [] )}
| x0 = A xs = list___anonymous_0_A_B__
| x' = A xs = list___anonymous_0_A_B__
{let x =
let x = x0 in
let x = x' in
( Left x )
in
( x :: xs )}
| y0 = B xs = list___anonymous_0_A_B__
| y = B xs = list___anonymous_0_A_B__
{let x =
let y = y0 in
( Right y )
in
( x :: xs )}
......@@ -27,15 +26,14 @@ in
list___anonymous_0_C_D__:
{ ( [] )}
| x0 = C xs = list___anonymous_0_C_D__
| x' = C xs = list___anonymous_0_C_D__
{let x =
let x = x0 in
let x = x' in
( Left x )
in
( x :: xs )}
| y0 = D xs = list___anonymous_0_C_D__
| y = D xs = list___anonymous_0_C_D__
{let x =
let y = y0 in
( Right y )
in
( x :: xs )}
......
......@@ -10,21 +10,21 @@
list___anonymous_0_:
{ ( [] )}
| x0 = A xs = list___anonymous_0_
| x' = A xs = list___anonymous_0_
{let x =
let x = x0 in
let x = x' in
( x )
in
( x :: xs )}
| x0 = B xs = list___anonymous_0_
| x' = B xs = list___anonymous_0_
{let x =
let x = x0 in
let x = x' in
( x )
in
( x :: xs )}
| x0 = C xs = list___anonymous_0_
| x' = C xs = list___anonymous_0_
{let x =
let x = x0 in
let x = x' in
( x )
in
( x :: xs )}
......@@ -32,10 +32,9 @@ in
list___anonymous_1_:
{ ( [] )}
| x0 = D y0 = D xs = list___anonymous_1_
| x' = D y = D xs = list___anonymous_1_
{let x =
let y = y0 in
let x = x0 in
let x = x' in
( x + y )
in
( x :: xs )}
......
......@@ -44,17 +44,15 @@ separated_nonempty_list_DOT_clause_:
{ ( x :: xs )}
clauses:
xs0 = loption_separated_nonempty_list_DOT_clause__ _2 = EOF
xs = loption_separated_nonempty_list_DOT_clause__ _2 = EOF
{let clauses =
let xs = xs0 in
( xs )
in
( clauses )}
clause:
tm = term _2 = INFERS xs0 = loption_separated_nonempty_list_COMMA_term__
tm = term _2 = INFERS xs = loption_separated_nonempty_list_COMMA_term__
{let ts =
let xs = xs0 in
( xs )
in
( (tm, ts) )}
......@@ -71,13 +69,9 @@ term:
{ ( Var (0, v) )}
params:
_10 = LPARENT xs00 = loption_separated_nonempty_list_COMMA_term__ _30 = RPARENT
_1 = LPARENT xs = loption_separated_nonempty_list_COMMA_term__ _3 = RPARENT
{let terms =
let _3 = _30 in
let xs0 = xs00 in
let _1 = _10 in
let x =
let xs = xs0 in
( xs )
in
( x )
......
......@@ -22,41 +22,33 @@ expr:
{ ( i )}
| _1 = LPAREN e = expr _3 = RPAREN
{ ( e )}
| e1 = expr _100 = PLUS e2 = expr
| e1 = expr _1 = PLUS e2 = expr
{let op =
let _10 = _100 in
let x =
let _1 = _10 in
( (+) )
in
( x )
in
( op e1 e2 )}
| e1 = expr _100 = MINUS e2 = expr
| e1 = expr _1 = MINUS e2 = expr
{let op =
let _10 = _100 in
let x =
let _1 = _10 in
( (-) )
in
( x )
in
( op e1 e2 )}
| e1 = expr _100 = TIMES e2 = expr
| e1 = expr _1 = TIMES e2 = expr
{let op =
let _10 = _100 in
let x =
let _1 = _10 in
( ( * ) )
in
( x )
in
( op e1 e2 )}
| e1 = expr _100 = DIV e2 = expr
| e1 = expr _1 = DIV e2 = expr
{let op =
let _10 = _100 in
let x =
let _1 = _10 in
( (/) )
in
( x )
......
......@@ -1608,9 +1608,8 @@ objectDefn:
{ ()}
defaultSyntax:
_1 = LeftBrace xs0 = loption_separated_nonempty_list_Comma_fieldSetting__ _3 = RightBrace
_1 = LeftBrace xs = loption_separated_nonempty_list_Comma_fieldSetting__ _3 = RightBrace
{let _2 =
let xs = xs0 in
( xs )
in
()}
......@@ -1734,9 +1733,8 @@ generalConstraint:
{ ()}
userDefinedConstraint:
_1 = CONSTRAINED _2 = BY _3 = LeftBrace xs0 = loption_separated_nonempty_list_Comma_userDefinedConstraintParameter__ _5 = RightBrace
_1 = CONSTRAINED _2 = BY _3 = LeftBrace xs = loption_separated_nonempty_list_Comma_userDefinedConstraintParameter__ _5 = RightBrace
{let _4 =
let xs = xs0 in
( xs )
in
()}
......
......@@ -349,10 +349,9 @@ list_mzl_statement__:
list_pair_dots_when_TEllipsis_pre_post_decl_statement_or_expression_rule_elem_statement__exp_decl_statement_list__:
{ ( [] )}
| x0 = dots_when_TEllipsis_pre_post_decl_statement_or_expression_rule_elem_statement_ y0 = exp_decl_statement_list xs = list_pair_dots_when_TEllipsis_pre_post_decl_statement_or_expression_rule_elem_statement__exp_decl_statement_list__
| x' = dots_when_TEllipsis_pre_post_decl_statement_or_expression_rule_elem_statement_ y = exp_decl_statement_list xs = list_pair_dots_when_TEllipsis_pre_post_decl_statement_or_expression_rule_elem_statement__exp_decl_statement_list__
{let x =
let y = y0 in
let x = x0 in
let x = x' in
( (x, y) )
in
( x :: xs )}
......@@ -360,10 +359,9 @@ in
list_pair_edots_when_TEllipsis_eexpr__dexpr__:
{ ( [] )}
| x0 = edots_when_TEllipsis_eexpr_ y0 = dexpr xs = list_pair_edots_when_TEllipsis_eexpr__dexpr__
| x' = edots_when_TEllipsis_eexpr_ y = dexpr xs = list_pair_edots_when_TEllipsis_eexpr__dexpr__
{let x =
let y = y0 in
let x = x0 in
let x = x' in
( (x, y) )
in
( x :: xs )}
......@@ -464,9 +462,8 @@ in
raise (Semantic_cocci.Semantic ("repeated rule name"))
with Not_found -> ());
(n,d,i) )}
| nm = pure_ident _2 = extends d = depends x0 = choose_iso _5 = TArob
| nm = pure_ident _2 = extends d = depends x = choose_iso _5 = TArob
{let i =
let x = x0 in
( Some x )
in
( let n = P.id2name nm in
......@@ -498,9 +495,8 @@ choose_iso:
{ ( P.id2name _2 )}
metadec:
ar = arity ispure = pure _10 = TIdentifier ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
ar = arity ispure = pure _1 = TIdentifier ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaIdDecl(arity,name)) in
!Data.add_id_meta name pure; tok) )
......@@ -517,10 +513,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TFresh _20 = TIdentifier ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TFresh _2 = TIdentifier ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _2 = _20 in
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaFreshIdDecl(arity,name)) in
!Data.add_id_meta name pure; tok) )
......@@ -537,9 +531,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TType ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TType ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaTypeDecl(arity,name)) in
!Data.add_type_meta name pure; tok) )
......@@ -556,9 +549,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TParameter ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TParameter ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaParamDecl(arity,name)) in
!Data.add_param_meta name pure; tok) )
......@@ -575,10 +567,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TParameter _20 = Tlist ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TParameter _2 = Tlist ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _2 = _20 in
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaParamListDecl(arity,name)) in
!Data.add_paramlist_meta name pure; tok))
......@@ -595,9 +585,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TError ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TError ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaErrDecl(arity,name)) in
!Data.add_err_meta name pure; tok) )
......@@ -614,9 +603,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TExpression ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TExpression ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaExpDecl(arity,name,None)) in
!Data.add_exp_meta None name pure; tok) )
......@@ -633,10 +621,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TExpression _20 = Tlist ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TExpression _2 = Tlist ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _2 = _20 in
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaExpListDecl(arity,name)) in
!Data.add_explist_meta name pure; tok) )
......@@ -653,10 +639,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TExpression m0 = nonempty_list_TMul_ ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TExpression m = nonempty_list_TMul_ ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let m = m0 in
let _1 = _10 in
( (fun arity name pure check_meta ->
let ty = Some [P.ty_pointerify Type_cocci.Unknown m] in
let tok = check_meta(Ast.MetaExpDecl(arity,name,ty)) in
......@@ -674,9 +658,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TStatement ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TStatement ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaStmDecl(arity,name)) in
!Data.add_stm_meta name pure; tok) )
......@@ -693,10 +676,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TStatement _20 = Tlist ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TStatement _2 = Tlist ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _2 = _20 in
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaStmListDecl(arity,name)) in
!Data.add_stmlist_meta name pure; tok) )
......@@ -713,9 +694,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TFunction ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TFunction ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaFuncDecl(arity,name)) in
!Data.add_func_meta name pure; tok) )
......@@ -732,10 +712,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TLocal _20 = TFunction ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TLocal _2 = TFunction ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _2 = _20 in
let _1 = _10 in
( (fun arity name pure check_meta ->
let tok = check_meta(Ast.MetaLocalFuncDecl(arity,name)) in
!Data.add_local_func_meta name pure;
......@@ -753,9 +731,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure vl0 = meta_exp_type ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure vl = meta_exp_type ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let vl = vl0 in
( (fun arity name pure check_meta ->
let ty = Some vl in
let tok = check_meta(Ast.MetaExpDecl(arity,name,ty)) in
......@@ -773,11 +750,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure vl0 = meta_exp_type _20 = TOCro _30 = TCCro ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure vl = meta_exp_type _2 = TOCro _3 = TCCro ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _3 = _30 in
let _2 = _20 in
let vl = vl0 in
( (fun arity name pure check_meta ->
let ty = Some (List.map (function x -> Type_cocci.Array x) vl) in
let tok = check_meta(Ast.MetaExpDecl(arity,name,ty)) in
......@@ -795,9 +769,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TConstant ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TConstant ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _1 = _10 in
let ty =
( None )
in
......@@ -817,12 +790,9 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TConstant x00 = meta_exp_type ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TConstant x = meta_exp_type ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let x0 = x00 in
let _1 = _10 in
let ty =
let x = x0 in
( Some x )
in
( (fun arity name pure check_meta ->
......@@ -841,9 +811,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TTypedef ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TTypedef ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =
let _1 = _10 in
( (fun arity (_,name) pure check_meta ->
if arity = Ast.NONE && pure = Ast0.Impure
then (!Data.add_type_name name; [])
......@@ -861,9 +830,8 @@ in
function x -> P.check_meta x; [Common.Right x]) in
kindfn ar rule ispure checker)
ids) )}
| ar = arity ispure = pure _10 = TDeclarer ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
| ar = arity ispure = pure _1 = TDeclarer ids = comma_list_pure_ident_or_meta_ident_ _5 = TMPtVirg
{let kindfn =