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 715da550 authored by MARCHE Claude's avatar MARCHE Claude
Browse files

restore support for literal constant

parent a9b6833f
...@@ -10,8 +10,8 @@ theory Utils ...@@ -10,8 +10,8 @@ theory Utils
use import bv.BV32 use import bv.BV32
let constant one : t = 1 let constant one : t = (1:bool)
let constant two : t = 2 let constant two : t = (2:t)
let constant lastbit : t = sub size_bv one let constant lastbit : t = sub size_bv one
function max (x y : t) : t = (if ult x y then y else x) function max (x y : t) : t = (if ult x y then y else x)
......
...@@ -826,12 +826,14 @@ let t_nat_const n = ...@@ -826,12 +826,14 @@ let t_nat_const n =
exception InvalidLiteralType of ty exception InvalidLiteralType of ty
let t_const c ty = let check_literal c ty =
let ts = match ty.ty_node with let ts = match ty.ty_node with
| Tyapp (ts,[]) -> ts | Tyapp (ts,[]) -> ts
| _ -> raise (InvalidLiteralType ty) in | _ -> raise (InvalidLiteralType ty) in
begin match c with match c with
| Number.ConstInt c when not (ts_equal ts ts_int) -> | Number.ConstInt c when not (ts_equal ts ts_int) ->
Format.eprintf "check literal %a of type %s@."
Number.print_integer_constant c ts.ts_name.id_string;
begin match ts.ts_def with begin match ts.ts_def with
| Range ir -> Number.check_range c ir | Range ir -> Number.check_range c ir
| _ -> raise (InvalidLiteralType ty) | _ -> raise (InvalidLiteralType ty)
...@@ -842,8 +844,8 @@ let t_const c ty = ...@@ -842,8 +844,8 @@ let t_const c ty =
| _ -> raise (InvalidLiteralType ty) | _ -> raise (InvalidLiteralType ty)
end end
| _ -> () | _ -> ()
end;
t_const c ty let t_const c ty = check_literal c ty; t_const c ty
let t_if f t1 t2 = let t_if f t1 t2 =
t_ty_check t2 t1.t_ty; t_ty_check t2 t1.t_ty;
...@@ -1675,4 +1677,3 @@ module TermTF = struct ...@@ -1675,4 +1677,3 @@ module TermTF = struct
let tr_fold fnT fnF = tr_fold (t_selecti fnT fnF) let tr_fold fnT fnF = tr_fold (t_selecti fnT fnF)
let tr_map_fold fnT fnF = tr_map_fold (t_selecti fnT fnF) let tr_map_fold fnT fnF = tr_map_fold (t_selecti fnT fnF)
end end
...@@ -201,6 +201,8 @@ val t_app_infer : lsymbol -> term list -> term ...@@ -201,6 +201,8 @@ val t_app_infer : lsymbol -> term list -> term
val ls_arg_inst : lsymbol -> term list -> ty Mtv.t val ls_arg_inst : lsymbol -> term list -> ty Mtv.t
val ls_app_inst : lsymbol -> term list -> ty option -> ty Mtv.t val ls_app_inst : lsymbol -> term list -> ty option -> ty Mtv.t
val check_literal : Number.constant -> ty -> unit
val t_var : vsymbol -> term val t_var : vsymbol -> term
val t_const : Number.constant -> ty -> term val t_const : Number.constant -> ty -> term
val t_if : term -> term -> term -> term val t_if : term -> term -> term -> term
......
...@@ -224,8 +224,10 @@ let dity_real = Dapp (its_real, [], []) ...@@ -224,8 +224,10 @@ let dity_real = Dapp (its_real, [], [])
let dity_bool = Dapp (its_bool, [], []) let dity_bool = Dapp (its_bool, [], [])
let dity_unit = Dapp (its_unit, [], []) let dity_unit = Dapp (its_unit, [], [])
(*
let dvty_int = [], dity_int let dvty_int = [], dity_int
let dvty_real = [], dity_real let dvty_real = [], dity_real
*)
let dvty_bool = [], dity_bool let dvty_bool = [], dity_bool
let dvty_unit = [], dity_unit let dvty_unit = [], dity_unit
...@@ -403,7 +405,7 @@ and dexpr_node = ...@@ -403,7 +405,7 @@ and dexpr_node =
| DEpv of pvsymbol | DEpv of pvsymbol
| DErs of rsymbol | DErs of rsymbol
| DEls of lsymbol | DEls of lsymbol
| DEconst of Number.constant | DEconst of Number.constant * dity
| DEapp of dexpr * dexpr | DEapp of dexpr * dexpr
| DEfun of dbinder list * mask * dspec later * dexpr | DEfun of dbinder list * mask * dspec later * dexpr
| DEany of dbinder list * mask * dspec later * dity | DEany of dbinder list * mask * dspec later * dity
...@@ -641,10 +643,7 @@ let dexpr ?loc node = ...@@ -641,10 +643,7 @@ let dexpr ?loc node =
specialize_rs rs specialize_rs rs
| DEls ls -> | DEls ls ->
specialize_ls ls specialize_ls ls
| DEconst (Number.ConstInt _) -> | DEconst (_, ity) -> [],ity
dvty_int
| DEconst (Number.ConstReal _) ->
dvty_real
| DEapp ({de_dvty = (arg::argl, res)}, de2) -> | DEapp ({de_dvty = (arg::argl, res)}, de2) ->
dexpr_expected_type de2 arg; dexpr_expected_type de2 arg;
argl, res argl, res
...@@ -1139,8 +1138,8 @@ and try_expr uloc env ({de_dvty = argl,res} as de0) = ...@@ -1139,8 +1138,8 @@ and try_expr uloc env ({de_dvty = argl,res} as de0) =
e_var (get_pv env n) e_var (get_pv env n)
| DEpv v -> | DEpv v ->
e_var v e_var v
| DEconst c -> | DEconst(c,dity) ->
e_const c e_const c (ity_of_dity dity)
| DEapp ({de_dvty = ([],_)} as de1, de2) -> | DEapp ({de_dvty = ([],_)} as de1, de2) ->
let e1 = expr uloc env de1 in let e1 = expr uloc env de1 in
let e2 = expr uloc env de2 in let e2 = expr uloc env de2 in
......
...@@ -23,8 +23,12 @@ val dity_fresh : unit -> dity ...@@ -23,8 +23,12 @@ val dity_fresh : unit -> dity
val dity_of_ity : ity -> dity val dity_of_ity : ity -> dity
val dity_int : dity
val dity_real : dity
type dvty = dity list * dity (* A -> B -> C == ([A;B],C) *) type dvty = dity list * dity (* A -> B -> C == ([A;B],C) *)
(** Patterns *) (** Patterns *)
type dpattern = private { type dpattern = private {
...@@ -92,7 +96,7 @@ and dexpr_node = ...@@ -92,7 +96,7 @@ and dexpr_node =
| DEpv of pvsymbol | DEpv of pvsymbol
| DErs of rsymbol | DErs of rsymbol
| DEls of lsymbol | DEls of lsymbol
| DEconst of Number.constant | DEconst of Number.constant * dity
| DEapp of dexpr * dexpr | DEapp of dexpr * dexpr
| DEfun of dbinder list * mask * dspec later * dexpr | DEfun of dbinder list * mask * dspec later * dexpr
| DEany of dbinder list * mask * dspec later * dity | DEany of dbinder list * mask * dspec later * dity
......
...@@ -463,14 +463,12 @@ let e_var ({pv_ity = ity; pv_ghost = ghost} as v) = ...@@ -463,14 +463,12 @@ let e_var ({pv_ity = ity; pv_ghost = ghost} as v) =
let eff = eff_ghostify ghost (eff_read_single v) in let eff = eff_ghostify ghost (eff_read_single v) in
mk_expr (Evar v) ity MaskVisible eff mk_expr (Evar v) ity MaskVisible eff
let e_const c = let e_const c ity =
let ity = match c with Term.check_literal c (ty_of_ity ity);
| Number.ConstInt _ -> ity_int
| Number.ConstReal _ -> ity_real in
mk_expr (Econst c) ity MaskVisible eff_empty mk_expr (Econst c) ity MaskVisible eff_empty
let e_nat_const n = let e_nat_const n =
e_const (Number.ConstInt (Number.int_const_dec (string_of_int n))) e_const (Number.ConstInt (Number.int_const_dec (string_of_int n))) ity_int
let e_ghostify gh ({e_effect = eff} as e) = let e_ghostify gh ({e_effect = eff} as e) =
if not gh then e else if not gh then e else
......
...@@ -190,7 +190,7 @@ val c_any : cty -> cexp ...@@ -190,7 +190,7 @@ val c_any : cty -> cexp
val e_var : pvsymbol -> expr val e_var : pvsymbol -> expr
val e_const : Number.constant -> expr val e_const : Number.constant -> ity -> expr
val e_nat_const : int -> expr val e_nat_const : int -> expr
val e_exec : cexp -> expr val e_exec : cexp -> expr
......
...@@ -829,7 +829,7 @@ let clone_ppat cl sm pp mask = ...@@ -829,7 +829,7 @@ let clone_ppat cl sm pp mask =
let rec clone_expr cl sm e = e_label_copy e (match e.e_node with let rec clone_expr cl sm e = e_label_copy e (match e.e_node with
| Evar v -> e_var (sm_find_pv sm v) | Evar v -> e_var (sm_find_pv sm v)
| Econst c -> e_const c | Econst c -> e_const c e.e_ity
| Eexec (c,_) -> e_exec (clone_cexp cl sm c) | Eexec (c,_) -> e_exec (clone_cexp cl sm c)
| Eassign asl -> | Eassign asl ->
let conv (r,f,v) = let conv (r,f,v) =
......
...@@ -618,7 +618,8 @@ let rec dexpr muc denv {expr_desc = desc; expr_loc = loc} = ...@@ -618,7 +618,8 @@ let rec dexpr muc denv {expr_desc = desc; expr_loc = loc} =
| e23 -> | e23 ->
apply loc de1 op1 (dexpr muc denv e23) in apply loc de1 op1 (dexpr muc denv e23) in
chain "q1 " "q2 " loc (dexpr muc denv e1) op1 e23 chain "q1 " "q2 " loc (dexpr muc denv e1) op1 e23
| Ptree.Econst c -> DEconst c | Ptree.Econst (Number.ConstInt _ as c) -> DEconst(c, dity_int)
| Ptree.Econst (Number.ConstReal _ as c) -> DEconst(c, dity_real)
| Ptree.Erecord fl -> | Ptree.Erecord fl ->
let ls_of_rs rs = match rs.rs_logic with let ls_of_rs rs = match rs.rs_logic with
| RLls ls -> ls | _ -> assert false in | RLls ls -> ls | _ -> assert false in
...@@ -747,7 +748,12 @@ let rec dexpr muc denv {expr_desc = desc; expr_loc = loc} = ...@@ -747,7 +748,12 @@ let rec dexpr muc denv {expr_desc = desc; expr_loc = loc} =
| Ptree.Enamed (Lstr lab, e1) -> | Ptree.Enamed (Lstr lab, e1) ->
DElabel (dexpr muc denv e1, Slab.singleton lab) DElabel (dexpr muc denv e1, Slab.singleton lab)
| Ptree.Ecast (e1, pty) -> | Ptree.Ecast (e1, pty) ->
DEcast (dexpr muc denv e1, ity_of_pty muc pty)) let e1 = dexpr muc denv e1 in
let ity = ity_of_pty muc pty in
let dity = dity_of_ity ity in
match e1.de_node with
| DEconst (c, _) -> DEconst (c, dity)
| _ -> DEcast (e1, ity))
and drec_defn muc denv fdl = and drec_defn muc denv fdl =
let prep (id, gh, kind, bl, pty, msk, sp, e) = let prep (id, gh, kind, bl, pty, msk, sp, e) =
......
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