Commit 32ab5e1e authored by MARCHE Claude's avatar MARCHE Claude
Browse files

Jessie3: very preliminary support for arrays

parent d6d57d99
...@@ -562,8 +562,9 @@ if test "$enable_frama_c" = yes ; then ...@@ -562,8 +562,9 @@ if test "$enable_frama_c" = yes ; then
FRAMAC_VERSION=`$FRAMAC -version | sed -n -e 's|Version: *\(.*\)$|\1|p'` FRAMAC_VERSION=`$FRAMAC -version | sed -n -e 's|Version: *\(.*\)$|\1|p'`
AC_MSG_RESULT($FRAMAC_VERSION) AC_MSG_RESULT($FRAMAC_VERSION)
case $FRAMAC_VERSION in case $FRAMAC_VERSION in
Fluorine-20130501) ;;
Fluorine-20130401) ;; Fluorine-20130401) ;;
*) AC_MSG_WARN(Version Fluorine-20130401 required.) *) AC_MSG_WARN(Version Fluorine-20130(4|5)01 required.)
enable_frama_c=no enable_frama_c=no
reason_frama_c=" (version Fluorine required)" reason_frama_c=" (version Fluorine required)"
;; ;;
......
...@@ -61,6 +61,7 @@ let env,config = ...@@ -61,6 +61,7 @@ let env,config =
Self.fatal "Exception raised in Why3 env:@ %a" Exn_printer.exn_printer e Self.fatal "Exception raised in Why3 env:@ %a" Exn_printer.exn_printer e
let find th s = Theory.ns_find_ls th.Theory.th_export [s] let find th s = Theory.ns_find_ls th.Theory.th_export [s]
let find_type th s = Theory.ns_find_ts th.Theory.th_export [s]
(* int.Int theory *) (* int.Int theory *)
let int_type : Ty.ty = Ty.ty_int let int_type : Ty.ty = Ty.ty_int
...@@ -74,7 +75,7 @@ let le_int : Term.lsymbol = find int_theory "infix <=" ...@@ -74,7 +75,7 @@ let le_int : Term.lsymbol = find int_theory "infix <="
let gt_int : Term.lsymbol = find int_theory "infix >" let gt_int : Term.lsymbol = find int_theory "infix >"
let lt_int : Term.lsymbol = find int_theory "infix <" let lt_int : Term.lsymbol = find int_theory "infix <"
let computer_div_theory : Theory.theory = let computer_div_theory : Theory.theory =
Env.find_theory env ["int"] "ComputerDivision" Env.find_theory env ["int"] "ComputerDivision"
let div_int : Term.lsymbol = find computer_div_theory "div" let div_int : Term.lsymbol = find computer_div_theory "div"
...@@ -87,6 +88,12 @@ let minus_real : Term.lsymbol = find real_theory "prefix -" ...@@ -87,6 +88,12 @@ let minus_real : Term.lsymbol = find real_theory "prefix -"
let mul_real : Term.lsymbol = find real_theory "infix *" let mul_real : Term.lsymbol = find real_theory "infix *"
let ge_real : Term.lsymbol = find real_theory "infix >=" let ge_real : Term.lsymbol = find real_theory "infix >="
(* map.Map theory *)
let map_theory : Theory.theory = Env.find_theory env ["map"] "Map"
let map_ts : Ty.tysymbol = find_type map_theory "map"
(* let map_type (t:Ty.ty) : Ty.ty = Ty.ty_app map_ts [t] *)
let map_get : Term.lsymbol = find map_theory "get"
(* ref.Ref module *) (* ref.Ref module *)
...@@ -112,10 +119,12 @@ let set_fun : Mlw_expr.psymbol = ...@@ -112,10 +119,12 @@ let set_fun : Mlw_expr.psymbol =
(* array.Array module *) (* array.Array module *)
(*
let array_modules, array_theories = let array_modules, array_theories =
Env.read_lib_file (Mlw_main.library_of_env env) ["array"] Env.read_lib_file (Mlw_main.library_of_env env) ["array"]
let array_module : Mlw_module.modul = Stdlib.Mstr.find "Array" array_modules let array_module : Mlw_module.modul = Stdlib.Mstr.find "Array" array_modules
*)
(* (*
let array_type : Mlw_ty.T.itysymbol = let array_type : Mlw_ty.T.itysymbol =
...@@ -132,27 +141,29 @@ let array_type : Mlw_ty.T.itysymbol = ...@@ -132,27 +141,29 @@ let array_type : Mlw_ty.T.itysymbol =
(*********) (*********)
let unit_type = Ty.ty_tuple [] let unit_type = Ty.ty_tuple []
let mlw_int_type = Mlw_ty.ity_pur Ty.ts_int []
let ctype ty = let ctype ty =
match ty with match ty with
| TVoid _attr -> Mlw_ty.ity_unit | TVoid _attr -> Mlw_ty.ity_unit
| TInt (_, _) -> Mlw_ty.ity_pur Ty.ts_int [] | TInt (_, _) -> mlw_int_type
| TFloat (_, _) -> | TFloat (_, _) ->
Self.not_yet_implemented "ctype TFloat" Self.not_yet_implemented "ctype TFloat"
| TPtr(_ty, _attr) -> | TPtr(TInt(_,_), _attr) ->
(* array_type *) Mlw_ty.ity_pur map_ts [mlw_int_type ; mlw_int_type]
| TPtr(_ty, _attr) ->
Self.not_yet_implemented "ctype TPtr" Self.not_yet_implemented "ctype TPtr"
| TArray (_, _, _, _) -> | TArray (_, _, _, _) ->
Self.not_yet_implemented "ctype TArray" Self.not_yet_implemented "ctype TArray"
| TFun (_, _, _, _) -> | TFun (_, _, _, _) ->
Self.not_yet_implemented "ctype TFun" Self.not_yet_implemented "ctype TFun"
| TNamed (_, _) -> | TNamed (_, _) ->
Self.not_yet_implemented "ctype TNamed" Self.not_yet_implemented "ctype TNamed"
| TComp (_, _, _) -> | TComp (_, _, _) ->
Self.not_yet_implemented "ctype TComp" Self.not_yet_implemented "ctype TComp"
| TEnum (_, _) -> | TEnum (_, _) ->
Self.not_yet_implemented "ctype TEnum" Self.not_yet_implemented "ctype TEnum"
| TBuiltin_va_list _ -> | TBuiltin_va_list _ ->
Self.not_yet_implemented "ctype TBuiltin_va_list" Self.not_yet_implemented "ctype TBuiltin_va_list"
let logic_types = Hashtbl.create 257 let logic_types = Hashtbl.create 257
...@@ -333,34 +344,18 @@ let result_vsymbol = ...@@ -333,34 +344,18 @@ let result_vsymbol =
type label = Here | Old | At of string type label = Here | Old | At of string
let tlval ~label (host,offset) = let is_int_type t =
match host,offset with match t with
| TResult _, TNoOffset -> Term.t_var !result_vsymbol | Linteger -> true
| TVar lv, TNoOffset -> | Ctype(TInt (_, _)) -> true
begin | _ -> false
let t =
match lv.lv_origin with let is_real_type t =
| None -> Term.t_var (get_lvar lv) match t with
| Some v -> | Lreal -> true
let (v,is_mutable,_ty) = get_var v in | Ctype(TFloat (_, _)) -> true
if is_mutable then | _ -> false
t_app get_logic_fun [Term.t_var v.Mlw_ty.pv_vs]
else
Term.t_var v.Mlw_ty.pv_vs
in
match label with
| Here -> t
| Old -> Mlw_wp.t_at_old t
| At _lab ->
(* t_app Mlw_wp.fs_at [t; ??? lab] *)
Self.not_yet_implemented "tlval TVar/At"
end
| TVar _, (TField (_, _)|TModel (_, _)|TIndex (_, _)) ->
Self.not_yet_implemented "tlval TVar"
| TResult _, _ ->
Self.not_yet_implemented "tlval Result"
| TMem _, _ ->
Self.not_yet_implemented "tlval Mem"
let rec term_node ~label t = let rec term_node ~label t =
match t with match t with
...@@ -385,11 +380,19 @@ let rec term_node ~label t = ...@@ -385,11 +380,19 @@ let rec term_node ~label t =
| LogicLabel(None, "Here") -> snd (term ~label:Here t) | LogicLabel(None, "Here") -> snd (term ~label:Here t)
| LogicLabel(None, "Old") -> snd (term ~label:Old t) | LogicLabel(None, "Old") -> snd (term ~label:Old t)
| LogicLabel(None, lab) -> snd (term ~label:(At lab) t) | LogicLabel(None, lab) -> snd (term ~label:(At lab) t)
| LogicLabel(Some _, _lab) -> | LogicLabel(Some _, _lab) ->
Self.not_yet_implemented "term_node Tat/LogicLabel/Some" Self.not_yet_implemented "term_node Tat/LogicLabel/Some"
| StmtLabel _ -> | StmtLabel _ ->
Self.not_yet_implemented "term_node Tat/StmtLabel" Self.not_yet_implemented "term_node Tat/StmtLabel"
end end
| TCoerce (_, _)->
Self.not_yet_implemented "TCoerce"
| TCoerceE (_, _)->
Self.not_yet_implemented "TCoerceE"
| TLogic_coerce (ty, t) when is_int_type ty->
snd (term ~label t)
| TLogic_coerce (_, _) ->
Self.not_yet_implemented "TLogic_coerce"
| TSizeOf _ | TSizeOf _
| TSizeOfE _ | TSizeOfE _
| TSizeOfStr _ | TSizeOfStr _
...@@ -403,10 +406,8 @@ let rec term_node ~label t = ...@@ -403,10 +406,8 @@ let rec term_node ~label t =
| Tbase_addr (_, _) | Tbase_addr (_, _)
| Toffset (_, _) | Toffset (_, _)
| Tblock_length (_, _) | Tblock_length (_, _)
| Tnull | Tnull ->
| TCoerce (_, _) Self.not_yet_implemented "term_node (1)"
| TCoerceE (_, _)
| TLogic_coerce (_, _)
| TUpdate (_, _, _) | TUpdate (_, _, _)
| Ttypeof _ | Ttypeof _
| Ttype _ | Ttype _
...@@ -416,10 +417,53 @@ let rec term_node ~label t = ...@@ -416,10 +417,53 @@ let rec term_node ~label t =
| Tcomprehension (_, _, _) | Tcomprehension (_, _, _)
| Trange (_, _) | Trange (_, _)
| Tlet (_, _) -> | Tlet (_, _) ->
Self.not_yet_implemented "term_node" Self.not_yet_implemented "term_node (2)"
and term ~label t = (t.term_type, term_node ~label t.term_node) and term ~label t = (t.term_type, term_node ~label t.term_node)
and tlval ~label (host,offset) =
match host,offset with
| TResult _, TNoOffset -> Term.t_var !result_vsymbol
| TVar lv, TNoOffset ->
begin
let t =
match lv.lv_origin with
| None -> Term.t_var (get_lvar lv)
| Some v ->
let (v,is_mutable,_ty) = get_var v in
if is_mutable then
t_app get_logic_fun [Term.t_var v.Mlw_ty.pv_vs]
else
Term.t_var v.Mlw_ty.pv_vs
in
match label with
| Here -> t
| Old -> Mlw_wp.t_at_old t
| At _lab ->
(* t_app Mlw_wp.fs_at [t; ??? lab] *)
Self.not_yet_implemented "tlval TVar/At"
end
| TVar _, (TField (_, _)|TModel (_, _)|TIndex (_, _)) ->
Self.not_yet_implemented "tlval TVar"
| TResult _, _ ->
Self.not_yet_implemented "tlval Result"
| TMem({term_node = TBinOp((PlusPI|IndexPI),t,i)}), TNoOffset ->
(* t[i] *)
t_app map_get [snd(term ~label t);snd(term ~label i)]
| TMem({term_node = TBinOp(_,t,i)}), TNoOffset ->
Self.not_yet_implemented "tlval Mem(TBinOp(_,%a,%a), TNoOffset)"
Cil_printer.pp_term t Cil_printer.pp_term i
| TMem t, TNoOffset ->
Self.not_yet_implemented "tlval Mem(%a, TNoOffset)"
Cil_printer.pp_term t
| TMem _t, TField _ ->
Self.not_yet_implemented "tlval Mem TField"
| TMem _t, TModel _ ->
Self.not_yet_implemented "tlval Mem TModel"
| TMem _t, TIndex _ ->
Self.not_yet_implemented "tlval Mem TNoOffset"
(****************) (****************)
...@@ -427,18 +471,23 @@ and term ~label t = (t.term_type, term_node ~label t.term_node) ...@@ -427,18 +471,23 @@ and term ~label t = (t.term_type, term_node ~label t.term_node)
(****************) (****************)
let rel (ty1,t1) op (ty2,t2) = let rel (ty1,t1) op (ty2,t2) =
match op,ty1,ty2 with match op with
| Req,_,_ -> Term.t_equ t1 t2 | Req -> Term.t_equ t1 t2
| Rneq,_,_ -> Term.t_neq t1 t2 | Rneq -> Term.t_neq t1 t2
| Rge,Linteger,Linteger -> t_app ge_int [t1;t2] | Rge when is_int_type ty1 && is_int_type ty2 -> t_app ge_int [t1;t2]
| Rle,Linteger,Linteger -> t_app le_int [t1;t2] | Rle when is_int_type ty1 && is_int_type ty2 -> t_app le_int [t1;t2]
| Rgt,Linteger,Linteger -> t_app gt_int [t1;t2] | Rgt when is_int_type ty1 && is_int_type ty2 -> t_app gt_int [t1;t2]
| Rlt,Linteger,Linteger -> t_app lt_int [t1;t2] | Rlt when is_int_type ty1 && is_int_type ty2 -> t_app lt_int [t1;t2]
| Rge,Lreal,Lreal -> t_app ge_real [t1;t2] | Rge when is_real_type ty1 && is_real_type ty2 -> t_app ge_real [t1;t2]
| Rge,_,_ -> | Rge ->
Self.not_yet_implemented "rel Rge" Self.not_yet_implemented "rel Rge"
| (Rlt|Rgt|Rle),_,_ -> | Rle ->
Self.not_yet_implemented "rel" Self.not_yet_implemented "rel Rle"
| Rgt ->
Self.not_yet_implemented "rel Rgt"
| Rlt ->
Self.not_yet_implemented "rel Rlt %a %a"
Cil_printer.pp_logic_type ty1 Cil_printer.pp_logic_type ty2
let rec predicate ~label p = let rec predicate ~label p =
match p with match p with
...@@ -601,26 +650,6 @@ let identified_proposition p = ...@@ -601,26 +650,6 @@ let identified_proposition p =
let lval (host,offset) =
match host,offset with
| Var v, NoOffset ->
let v,is_mutable,ty = get_var v in
if is_mutable then
begin try
Mlw_expr.e_app
(mk_get v.Mlw_ty.pv_ity ty)
[Mlw_expr.e_value v]
with e ->
Self.fatal "Exception raised during application of !@ %a@."
Exn_printer.exn_printer e
end
else
Mlw_expr.e_value v
| Var _, (Field (_, _)|Index (_, _)) ->
Self.not_yet_implemented "lval Var"
| Mem _, _ ->
Self.not_yet_implemented "lval Mem"
let seq e1 e2 = let seq e1 e2 =
let l = Mlw_expr.create_let_defn (Ident.id_fresh "_tmp") e1 in let l = Mlw_expr.create_let_defn (Ident.id_fresh "_tmp") e1 in
...@@ -724,6 +753,45 @@ let rec expr e = ...@@ -724,6 +753,45 @@ let rec expr e =
| Info (_, _) | Info (_, _)
-> Self.not_yet_implemented "expr" -> Self.not_yet_implemented "expr"
and lval (host,offset) =
match host,offset with
| Var v, NoOffset ->
let v,is_mutable,ty = get_var v in
if is_mutable then
begin try
Mlw_expr.e_app
(mk_get v.Mlw_ty.pv_ity ty)
[Mlw_expr.e_value v]
with e ->
Self.fatal "Exception raised during application of !@ %a@."
Exn_printer.exn_printer e
end
else
Mlw_expr.e_value v
| Var _, (Field (_, _)|Index (_, _)) ->
Self.not_yet_implemented "lval Var"
| Mem({enode = BinOp((PlusPI|IndexPI),e,i,ty)}), NoOffset ->
(* e[i] -> Map.get !e i *)
let e = expr e in
let ity = match e.Mlw_expr.e_vty with
| Mlw_ty.VTvalue ity -> ity
| Mlw_ty.VTarrow _ -> assert false
in
begin try
Mlw_expr.e_lapp map_get [e;expr i] ity
(*
let ty = ctype ty in
let t = Mlw_expr.e_app (mk_get ity ty) [e] in
t (* Mlw_expr.e_lapp map_get [t;expr i] ity *)
*)
with Mlw_ty.TypeMismatch(ity1,ity2,_ity_subst) ->
Self.fatal "e[i]: TypeMismatch(%a,%a,_)"
Mlw_pretty.print_ity ity1 Mlw_pretty.print_ity ity2
end
| Mem _, _ ->
Self.not_yet_implemented "lval Mem"
let assignment (lhost,offset) e _loc = let assignment (lhost,offset) e _loc =
match lhost,offset with match lhost,offset with
| Var v , NoOffset -> | Var v , NoOffset ->
...@@ -898,8 +966,8 @@ let fundecl fdec = ...@@ -898,8 +966,8 @@ let fundecl fdec =
in in
let spec = { let spec = {
Mlw_ty.c_pre = predicate_named ~label:Here pre; Mlw_ty.c_pre = predicate_named ~label:Here pre;
c_post = c_post =
Term.t_eps Term.t_eps
(Term.t_close_bound result (predicate_named ~label:Here post)); (Term.t_close_bound result (predicate_named ~label:Here post));
c_xpost = Mlw_ty.Mexn.empty; c_xpost = Mlw_ty.Mexn.empty;
c_effect = Mlw_ty.eff_empty; c_effect = Mlw_ty.eff_empty;
......
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
(* *) (* *)
(********************************************************************) (********************************************************************)
(* example of an option (* example of an option
module OutputFile = module OutputFile =
Self.EmptyString Self.EmptyString
(struct (struct
...@@ -25,7 +25,7 @@ open Why3 ...@@ -25,7 +25,7 @@ open Why3
let run_on_task fmt prover prover_driver t = let run_on_task fmt prover prover_driver t =
let result = let result =
Call_provers.wait_on_call Call_provers.wait_on_call
(Why3.Driver.prove_task (Why3.Driver.prove_task
~command:prover.Whyconf.command ~command:prover.Whyconf.command
~timelimit:3 ~timelimit:3
prover_driver t ()) () prover_driver t ()) ()
...@@ -33,7 +33,7 @@ let run_on_task fmt prover prover_driver t = ...@@ -33,7 +33,7 @@ let run_on_task fmt prover prover_driver t =
Format.fprintf fmt "%a" Call_provers.print_prover_answer result.Call_provers.pr_answer Format.fprintf fmt "%a" Call_provers.print_prover_answer result.Call_provers.pr_answer
let get_prover config env acc (short, name) = let get_prover config env acc (short, name) =
let prover = let prover =
try try
let fp = Whyconf.parse_filter_prover name in let fp = Whyconf.parse_filter_prover name in
let provers = Whyconf.filter_one_prover config fp in let provers = Whyconf.filter_one_prover config fp in
...@@ -55,17 +55,17 @@ let get_prover config env acc (short, name) = ...@@ -55,17 +55,17 @@ let get_prover config env acc (short, name) =
let process () = let process () =
let prog = Ast.get () in let prog = Ast.get () in
(* File.pretty_ast (); *) (* File.pretty_ast (); *)
let provers = let provers =
List.fold_left List.fold_left
(get_prover ACSLtoWhy3.config ACSLtoWhy3.env) (get_prover ACSLtoWhy3.config ACSLtoWhy3.env)
[] []
[ "Z42", "Z3,4.2"; [ "Z42", "Z3,4.3.1";
"Z32", "Z3,3.2"; "Z32", "Z3,3.2";
"C24", "CVC3,2.4.1"; "C24", "CVC3,2.4.1";
"C22", "CVC3,2.2"; "C22", "CVC3,2.2";
"A95", "Alt-Ergo,0.95,"; "A95", "Alt-Ergo,0.95.1,";
"A94", "Alt-Ergo,0.94"; (* "A94", "Alt-Ergo,0.94"; *)
] ]
in in
let theories = ACSLtoWhy3.prog prog in let theories = ACSLtoWhy3.prog prog in
try try
...@@ -73,16 +73,16 @@ let process () = ...@@ -73,16 +73,16 @@ let process () =
ACSLtoWhy3.Self.result "running theory 1:"; ACSLtoWhy3.Self.result "running theory 1:";
ACSLtoWhy3.Self.result "@[<hov 2>%a@]" Pretty.print_theory th; ACSLtoWhy3.Self.result "@[<hov 2>%a@]" Pretty.print_theory th;
let tasks = Task.split_theory th None None in let tasks = Task.split_theory th None None in
ACSLtoWhy3.Self.result "@[<h 0>%a@]" ACSLtoWhy3.Self.result "@[<h 0>%a@]"
(Pp.print_list Pp.comma (Pp.print_list Pp.comma
(fun fmt (_n,p,_d) -> (fun fmt (_n,p,_d) ->
let p = p.Whyconf.prover in let p = p.Whyconf.prover in
Format.fprintf fmt "%s %s" p.Whyconf.prover_name p.Whyconf.prover_version)) Format.fprintf fmt "%s %s" p.Whyconf.prover_name p.Whyconf.prover_version))
provers; provers;
let _ = let _ =
List.fold_left (fun n t -> List.fold_left (fun n t ->
ACSLtoWhy3.Self.result "@[<h 0>Task %d: %a@]" n ACSLtoWhy3.Self.result "@[<h 0>Task %d: %a@]" n
(Pp.print_list Pp.comma (fun fmt (_n,p,d) -> run_on_task fmt p d t)) (Pp.print_list Pp.comma (fun fmt (_n,p,d) -> run_on_task fmt p d t))
provers; provers;
n+1) 1 tasks n+1) 1 tasks
in ()) in ())
......
/*@ ensures \result == t[0];
@*/
int f(int t[]) {
return t[0];
}
/*
Local Variables:
compile-command: "frama-c -add-path ../.. -jessie3 array.c"
End:
*/
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