Maj terminée. Pour consulter la release notes associée voici le lien :
https://about.gitlab.com/releases/2021/07/07/critical-security-release-gitlab-14-0-4-released/

Commit 5287555a authored by POTTIER Francois's avatar POTTIER Francois
Browse files

CodeBits: replaced [filter_types] with [interface_to_structure], which is

more general and correct (the old code could change a set of nonrecursive
type definitions into a set of recursive type definitions).
parent d92bfe7f
* filter_typedefs * simplify Printer.functorparams
* Introduce a submodule Incremental for the incremental entry * Introduce a submodule Incremental for the incremental entry
points. Clean up IL to make it more general. points. Clean up IL to make it more general.
......
...@@ -1631,18 +1631,19 @@ let grammar = ...@@ -1631,18 +1631,19 @@ let grammar =
let program = let program =
[ SIFunctor (grammar.parameters, [ [ SIFunctor (grammar.parameters,
SIExcDefs [ excdef ]; SIExcDefs [ excdef ] ::
SITypeDefs ( interface_to_structure (
filter_typedefs (tokentypedefs grammar) @ tokentypedefs grammar
[ envtypedef; statetypedef ] ) @
);
SIStretch grammar.preludes; SITypeDefs [ envtypedef; statetypedef ] ::
SIValDefs (false, [ excvaldef ]); SIStretch grammar.preludes ::
SIValDefs (false, [ excvaldef ]) ::
SIValDefs (true, SIValDefs (true,
ProductionMap.fold (fun _ s defs -> ProductionMap.fold (fun _ s defs ->
...@@ -1659,11 +1660,11 @@ let program = ...@@ -1659,11 +1660,11 @@ let program =
else else
defs defs
) [ discarddef; initenvdef; printtokendef; assertfalsedef; errorcasedef ]))) ) [ discarddef; initenvdef; printtokendef; assertfalsedef; errorcasedef ])))
); ) ::
SIStretch grammar.postludes; SIStretch grammar.postludes ::
])] [])]
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
(* We are done! *) (* We are done! *)
......
...@@ -153,14 +153,21 @@ let tvprefix name = ...@@ -153,14 +153,21 @@ let tvprefix name =
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
let filter_typedefs (items : interface_item list) : typedef list = (* Converting an interface to a structure. Only exception and type definitions
(* TEMPORARY ideally, should not flatten, as this turns a nonrecursive go through. *)
definition into a recursive one *)
List.flatten (List.map (fun item -> let interface_item_to_structure_item = function
match item with | IIExcDecls defs ->
| IITypeDecls defs -> [ SIExcDefs defs ]
defs | IITypeDecls defs ->
| _ -> [ SITypeDefs defs ]
[] | IIFunctor (_, _)
) items) | IIValDecls _
| IIInclude _
| IIModule (_, _)
| IIComment _ ->
[]
let interface_to_structure i =
List.flatten (List.map interface_item_to_structure_item i)
...@@ -54,7 +54,7 @@ val prefix: string -> string ...@@ -54,7 +54,7 @@ val prefix: string -> string
val dataprefix: string -> string val dataprefix: string -> string
val tvprefix: string -> string val tvprefix: string -> string
(* Projecting interface items to typedefs. Any interface items other (* Converting an interface to a structure. Only exception and type definitions
than typedefs are lost. *) go through. *)
val filter_typedefs: interface_item list -> typedef list val interface_to_structure: interface -> structure
...@@ -180,12 +180,12 @@ let program grammar = ...@@ -180,12 +180,12 @@ let program grammar =
tokens, because, in principle, the semantic actions may refer to tokens, because, in principle, the semantic actions may refer to
it or to its data constructors. *) it or to its data constructors. *)
[ SIFunctor (grammar.parameters, [ [ SIFunctor (grammar.parameters,
SITypeDefs (filter_typedefs (tokentypedefs grammar)); interface_to_structure (tokentypedefs grammar) @
SIStretch grammar.preludes; SIStretch grammar.preludes ::
SIValDefs (false, [ begindef; def; enddef ]); SIValDefs (false, [ begindef; def; enddef ]) ::
SIStretch grammar.postludes; SIStretch grammar.postludes ::
])] [])]
(* ------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------- *)
(* Writing the program associated with a grammar to a file. *) (* Writing the program associated with a grammar to a file. *)
......
...@@ -13,7 +13,7 @@ val tnonterminalgadt: IL.typ -> IL.typ ...@@ -13,7 +13,7 @@ val tnonterminalgadt: IL.typ -> IL.typ
information, or because [--infer] has been set and inference has been information, or because [--infer] has been set and inference has been
performed already. This definition is produced only in [--table] mode. *) performed already. This definition is produced only in [--table] mode. *)
val nonterminalgadtdef: UnparameterizedSyntax.grammar -> IL.interface_item list val nonterminalgadtdef: UnparameterizedSyntax.grammar -> IL.interface
(* When in [--(raw-)depend] mode, we are asked to produce a mock [.mli] file (* When in [--(raw-)depend] mode, we are asked to produce a mock [.mli] file
before [--infer] has run, which means that we are usually not able to before [--infer] has run, which means that we are usually not able to
......
...@@ -5,5 +5,5 @@ val tsymbolgadt: IL.typ -> IL.typ ...@@ -5,5 +5,5 @@ val tsymbolgadt: IL.typ -> IL.typ
(* The definition of the symbol GADT. This definition can be produced only if (* The definition of the symbol GADT. This definition can be produced only if
we are successfully able to construct the nonterminal GADT first. *) we are successfully able to construct the nonterminal GADT first. *)
val symbolgadtdef: UnparameterizedSyntax.grammar -> IL.interface_item list val symbolgadtdef: UnparameterizedSyntax.grammar -> IL.interface
...@@ -745,28 +745,29 @@ let grammar = ...@@ -745,28 +745,29 @@ let grammar =
let program = let program =
[ SIFunctor (grammar.parameters, [ [ SIFunctor (grammar.parameters,
SIExcDefs [ excdef ]; SIExcDefs [ excdef ] ::
SITypeDefs ( interface_to_structure (
filter_typedefs (tokentypedefs grammar) @ tokentypedefs grammar @
filter_typedefs (nonterminalgadtdef grammar) @ nonterminalgadtdef grammar @
filter_typedefs (symbolgadtdef grammar) @ symbolgadtdef grammar
[ tokendef1 ] ) @
);
SIStretch grammar.preludes; SITypeDefs [ tokendef1 ] ::
SIValDefs (false, [ excvaldef ]); SIStretch grammar.preludes ::
SIModuleDef (interpreter, application); SIValDefs (false, [ excvaldef ]) ::
SIValDefs (false, api); SIModuleDef (interpreter, application) ::
SIStretch grammar.postludes; SIValDefs (false, api) ::
])] SIStretch grammar.postludes ::
[])]
let () = let () =
Time.tick "Producing abstract syntax" Time.tick "Producing abstract syntax"
......
...@@ -117,7 +117,7 @@ let produce_tokentypes grammar = ...@@ -117,7 +117,7 @@ let produce_tokentypes grammar =
necessary by the fact that the two can be different necessary by the fact that the two can be different
when there are functor parameters. *) when there are functor parameters. *)
let items = typedefs grammar in let i = typedefs grammar in
let module P = let module P =
Printer.Make (struct Printer.Make (struct
...@@ -127,7 +127,7 @@ let produce_tokentypes grammar = ...@@ -127,7 +127,7 @@ let produce_tokentypes grammar =
end) end)
in in
P.interface [ P.interface [
IIFunctor (grammar.parameters, items) IIFunctor (grammar.parameters, i)
]; ];
let module P = let module P =
Printer.Make (struct Printer.Make (struct
...@@ -137,9 +137,9 @@ let produce_tokentypes grammar = ...@@ -137,9 +137,9 @@ let produce_tokentypes grammar =
end) end)
in in
P.program [ P.program [
SIFunctor (grammar.parameters, [ SIFunctor (grammar.parameters,
SITypeDefs (filter_typedefs items) interface_to_structure i
]) )
]; ];
exit 0 exit 0
......
...@@ -38,7 +38,7 @@ val tokenprefix: string -> string ...@@ -38,7 +38,7 @@ val tokenprefix: string -> string
the type [token] when not in [--table] mode, and the types [token] and the type [token] when not in [--table] mode, and the types [token] and
[terminal] when in [--table] mode. *) [terminal] when in [--table] mode. *)
val tokentypedefs: UnparameterizedSyntax.grammar -> IL.interface_item list val tokentypedefs: UnparameterizedSyntax.grammar -> IL.interface
(* If [--only-tokens] is set, then [produce_tokentypes] writes the type (* If [--only-tokens] is set, then [produce_tokentypes] writes the type
definitions to the [.ml] and [.mli] files and stops Menhir. Otherwise, definitions to the [.ml] and [.mli] files and stops Menhir. Otherwise,
......
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