Maj terminée. Pour consulter la release notes associée voici le lien :

Commit 715da550 by MARCHE Claude

### 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!