Mise à jour terminée. Pour connaître les apports de la version 13.8.4 par rapport à notre ancienne version vous pouvez lire les "Release Notes" suivantes :
https://about.gitlab.com/releases/2021/02/11/security-release-gitlab-13-8-4-released/
https://about.gitlab.com/releases/2021/02/05/gitlab-13-8-3-released/

Commit 96fb8710 authored by François Bobot's avatar François Bobot

encoding enumerate : forbidden with explicit

parent 54f72bbf
...@@ -64,30 +64,6 @@ let enco_kept = enco_gen kept_opt ...@@ -64,30 +64,6 @@ let enco_kept = enco_gen kept_opt
let enco_poly_smt = enco_gen poly_smt_opt let enco_poly_smt = enco_gen poly_smt_opt
let enco_poly_tptp = enco_gen poly_tptp_opt let enco_poly_tptp = enco_gen poly_tptp_opt
let forbid_for_explicit =
Encoding_enumeration.forbid_enumeration
"explicit is unsound in presence of this finite type"
let maybe_forbid_enumeration =
Trans.on_meta_excl poly_smt_opt.meta (fun alo ->
let s = match alo with
| None -> poly_smt_opt.default
| Some [MAstr s] -> s
| _ -> assert false in
if s = "explicit"
then forbid_for_explicit
else Trans.identity)
let forbid_enumeration =
Trans.on_meta_excl poly_smt_opt.meta (fun alo ->
let s = match alo with
| None -> poly_smt_opt.default
| Some [MAstr s] -> s
| _ -> assert false in
if s = "explicit"
then forbid_for_explicit
else Encoding_enumeration.encoding_enumeration)
open Ty open Ty
open Term open Term
...@@ -113,15 +89,15 @@ let monomorphise_goal = ...@@ -113,15 +89,15 @@ let monomorphise_goal =
let encoding_smt env = let encoding_smt env =
compose monomorphise_goal compose monomorphise_goal
(compose maybe_forbid_enumeration (compose (enco_select env)
(compose (enco_select env) (compose (enco_kept env) (enco_poly_smt env)))
(compose (enco_kept env) (enco_poly_smt env))))
let encoding_tptp env = let encoding_tptp env =
compose monomorphise_goal compose monomorphise_goal
(compose forbid_enumeration (compose (enco_select env)
(compose (enco_select env) (compose (enco_kept env)
(compose (enco_kept env) (enco_poly_tptp env)))) (compose (enco_poly_tptp env)
Encoding_enumeration.encoding_enumeration)))
let () = let () =
register_env_transform "encoding_smt" encoding_smt; register_env_transform "encoding_smt" encoding_smt;
......
...@@ -32,7 +32,6 @@ val register_enco_poly : string -> (env -> task trans) -> unit ...@@ -32,7 +32,6 @@ val register_enco_poly : string -> (env -> task trans) -> unit
val monomorphise_goal : Task.task Trans.trans val monomorphise_goal : Task.task Trans.trans
val maybe_forbid_enumeration : Task.task Trans.trans
val enco_poly_smt : Env.env -> Task.task Trans.trans val enco_poly_smt : Env.env -> Task.task Trans.trans
val print_kept : Task.task Trans.trans val print_kept : Task.task Trans.trans
......
...@@ -576,15 +576,14 @@ let encoding_smt_array env = ...@@ -576,15 +576,14 @@ let encoding_smt_array env =
Trans.on_used_theory th_array (fun used -> Trans.on_used_theory th_array (fun used ->
if not used then Encoding.encoding_smt env else if not used then Encoding.encoding_smt env else
compose Encoding.monomorphise_goal compose Encoding.monomorphise_goal
(compose Encoding.maybe_forbid_enumeration (compose (select_subterm_array th_array)
(compose (select_subterm_array th_array) (compose Encoding.print_kept
(compose Encoding.print_kept (compose (Encoding_instantiate.t
(compose (Encoding_instantiate.t (create_env_array env th_array))
(create_env_array env th_array)) (compose meta_arrays_to_meta_kept
(compose meta_arrays_to_meta_kept (compose Encoding.print_kept
(compose Encoding.print_kept (compose (Encoding_bridge.t env)
(compose (Encoding_bridge.t env) (Encoding.enco_poly_smt env))))))))
(Encoding.enco_poly_smt env)))))))))
let () = Trans.register_env_transform "encoding_smt_array" encoding_smt_array let () = Trans.register_env_transform "encoding_smt_array" encoding_smt_array
......
...@@ -45,6 +45,8 @@ let proj tenv t ty = match ty.ty_node with ...@@ -45,6 +45,8 @@ let proj tenv t ty = match ty.ty_node with
| Tyapp (ts,_) when Sts.mem ts tenv.enum -> | Tyapp (ts,_) when Sts.mem ts tenv.enum ->
let fs = Hts.find tenv.projs ts in let fs = Hts.find tenv.projs ts in
t_app fs [t] t.t_ty t_app fs [t] t.t_ty
| _ when ty_s_any (fun ts -> Sts.mem ts tenv.enum) t.t_ty ->
Printer.unsupportedType ty "complexe finite type"
| _ -> t | _ -> t
let proj tenv t = match t.t_node with let proj tenv t = match t.t_node with
...@@ -93,10 +95,5 @@ let encoding_enumeration = ...@@ -93,10 +95,5 @@ let encoding_enumeration =
let tenv = { enum = enum ; projs = projs } in let tenv = { enum = enum ; projs = projs } in
Trans.decl (decl tenv) None) Trans.decl (decl tenv) None)
let forbid_enumeration s =
Trans.on_tagged_ts meta_enum (fun enum ->
if Sts.is_empty enum then Trans.identity
else Printer.unsupportedTysymbol (Sts.choose enum) s)
let () = Trans.register_transform "encoding_enumeration" encoding_enumeration let () = Trans.register_transform "encoding_enumeration" encoding_enumeration
...@@ -18,6 +18,3 @@ ...@@ -18,6 +18,3 @@
(**************************************************************************) (**************************************************************************)
val encoding_enumeration : Task.task Trans.trans val encoding_enumeration : Task.task Trans.trans
val forbid_enumeration : string ->Task.task Trans.trans
(* [forbid_enumeration s] if the task contains encoded enumeration
unsupportedTysymbol is raised with the message [s] *)
...@@ -38,9 +38,11 @@ module Debug = struct ...@@ -38,9 +38,11 @@ module Debug = struct
(** utility to print a list of items *) (** utility to print a list of items *)
let rec print_list printer fmter = function let rec print_list printer fmter = function
| [] -> Format.fprintf fmter "" | [] -> Format.fprintf fmter ""
| e::es -> if es = [] | e::es ->
then Format.fprintf fmter "@[%a@] %a" printer e (print_list printer) es if es = [] then
else Format.fprintf fmter "@[%a@], %a" printer e (print_list printer) es Format.fprintf fmter "@[%a@] %a" printer e (print_list printer) es
else
Format.fprintf fmter "@[%a@], %a" printer e (print_list printer) es
let debug x = Format.eprintf "%s@." x let debug x = Format.eprintf "%s@." x
end end
...@@ -137,6 +139,15 @@ let decl d = match d.d_node with ...@@ -137,6 +139,15 @@ let decl d = match d.d_node with
let explicit = Trans.decl decl (Task.add_decl None d_ts_type) let explicit = Trans.decl decl (Task.add_decl None d_ts_type)
let meta_enum = Eliminate_algebraic.meta_enum
let explicit =
Trans.on_tagged_ts meta_enum (fun enum ->
if Sts.is_empty enum then explicit
else Printer.unsupportedTysymbol (Sts.choose enum)
"explicit is unsound in presence of type")
(** {2 monomorphise task } *) (** {2 monomorphise task } *)
let ts_base = create_tysymbol (id_fresh "uni") [] None let ts_base = create_tysymbol (id_fresh "uni") [] None
......
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