PVS printer: inductive predicates, mutually recursive functions

parent 04251b82
...@@ -5,11 +5,15 @@ fail "Syntax error: \\(.*\\)$" "\\1" ...@@ -5,11 +5,15 @@ fail "Syntax error: \\(.*\\)$" "\\1"
time "why3cpulimit time : %s s" time "why3cpulimit time : %s s"
transformation "inline_trivial" transformation "inline_trivial"
transformation "eliminate_builtin" transformation "eliminate_builtin"
(* PVS does not support mutual recursion *)
transformation "eliminate_mutual_recursion" transformation "eliminate_mutual_recursion"
transformation "simplify_recursive_definition"
(* though we could do better, we only use recursion on one argument *)
transformation "eliminate_non_struct_recursion" transformation "eliminate_non_struct_recursion"
(* PVS only has simple patterns *)
transformation "compile_match" transformation "compile_match"
transformation "simplify_formula" transformation "simplify_formula"
......
...@@ -44,18 +44,16 @@ QUESTIONS FOR THE PVS TEAM ...@@ -44,18 +44,16 @@ QUESTIONS FOR THE PVS TEAM
* pattern-matching * pattern-matching
- is there a catch-all pattern in PVS's CASES construct? - By mistake, I used _ as a catch-all in a CASES expressions
(as in ML and in Why3) and it made PVS go wild!
Note: I tried to use _ (as in ML and in Why3) and it made PVS go wild! * I intend to use the script "proveit" to replay PVS proofs (when they exist).
* I intend to use the script "proveit" to replay PVS proofs (when they exist)
What is the canonical way to check that all proofs have indeed been What is the canonical way to check that all proofs have indeed been
successfully replayed? successfully replayed? (exit code, grep on proveit's output, etc.)
TODO TODO
---- ----
* eliminate mutual recursion in PVS driver * use PVS maps
*) *)
...@@ -232,19 +230,21 @@ let print_or_list fmt x = print_list (fun fmt () -> fprintf fmt " OR@\n") fmt x ...@@ -232,19 +230,21 @@ let print_or_list fmt x = print_list (fun fmt () -> fprintf fmt " OR@\n") fmt x
let comma_newline fmt () = fprintf fmt ",@\n" let comma_newline fmt () = fprintf fmt ",@\n"
let rec print_pat info fmt p = match p.pat_node with let rec print_pat info fmt p = match p.pat_node with
| Pwild -> fprintf fmt "_" | Pvar v ->
| Pvar v -> print_vs fmt v print_vs fmt v
| Pas _ | Por _ -> | Papp (cs, _) when is_fs_tuple cs ->
assert false (* compile_match must have taken care of that *) assert false (* is handled earlier in print_term/fmla *)
| Papp (cs,pl) when is_fs_tuple cs -> | Papp (cs, pl) ->
fprintf fmt "%a" (print_paren_r (print_pat info)) pl
| Papp (cs,pl) ->
begin match query_syntax info.info_syn cs.ls_name with begin match query_syntax info.info_syn cs.ls_name with
| Some s -> syntax_arguments s (print_pat info) fmt pl | Some s -> syntax_arguments s (print_pat info) fmt pl
| _ when pl = [] -> (print_ls_real info) fmt cs | _ when pl = [] -> (print_ls_real info) fmt cs
| _ -> fprintf fmt "%a(%a)" | _ -> fprintf fmt "%a(%a)"
(print_ls_real info) cs (print_list comma (print_pat info)) pl (print_ls_real info) cs (print_list comma (print_pat info)) pl
end end
| Pas _ | Por _ ->
assert false (* compile_match must have taken care of that *)
| Pwild ->
assert false (* is handled in print_branches *)
let print_vsty_nopar info fmt v = let print_vsty_nopar info fmt v =
fprintf fmt "%a:%a" print_vs v (print_ty info) v.vs_ty fprintf fmt "%a:%a" print_vs v (print_ty info) v.vs_ty
...@@ -306,7 +306,7 @@ and print_tnode opl opr info fmt t = match t.t_node with ...@@ -306,7 +306,7 @@ and print_tnode opl opr info fmt t = match t.t_node with
in in
Print_number.print number_format fmt c Print_number.print number_format fmt c
| Tif (f, t1, t2) -> | Tif (f, t1, t2) ->
fprintf fmt "IF %a@ THEN %a@ ELSE %a ENDIF" fprintf fmt "IF %a@ THEN %a@ ELSE %a ENDIF"
(print_fmla info) f (print_term info) t1 (print_opl_term info) t2 (print_fmla info) f (print_term info) t1 (print_opl_term info) t2
| Tlet (t1, tb) -> | Tlet (t1, tb) ->
let v,t2 = t_open_bound tb in let v,t2 = t_open_bound tb in
...@@ -323,8 +323,7 @@ and print_tnode opl opr info fmt t = match t.t_node with ...@@ -323,8 +323,7 @@ and print_tnode opl opr info fmt t = match t.t_node with
Svs.iter forget_var p.pat_vars Svs.iter forget_var p.pat_vars
| Tcase (t, bl) -> | Tcase (t, bl) ->
fprintf fmt "CASES %a OF@\n@[<hov>%a@]@\nENDCASES" fprintf fmt "CASES %a OF@\n@[<hov>%a@]@\nENDCASES"
(print_term info) t (print_term info) t (print_branches print_term info) bl
(print_list comma_newline (print_tbranch info)) bl
| Teps fb -> | Teps fb ->
let v,f = t_open_bound fb in let v,f = t_open_bound fb in
fprintf fmt (protect_on opr "epsilon(LAMBDA (%a):@ %a)") fprintf fmt (protect_on opr "epsilon(LAMBDA (%a):@ %a)")
...@@ -391,8 +390,7 @@ and print_fnode opl opr info fmt f = match f.t_node with ...@@ -391,8 +390,7 @@ and print_fnode opl opr info fmt f = match f.t_node with
Svs.iter forget_var p.pat_vars Svs.iter forget_var p.pat_vars
| Tcase (t, bl) -> | Tcase (t, bl) ->
fprintf fmt "CASES %a OF@\n@[<hov>%a@]@\nENDCASES" fprintf fmt "CASES %a OF@\n@[<hov>%a@]@\nENDCASES"
(print_term info) t (print_term info) t (print_branches print_fmla info) bl
(print_list comma_newline (print_fbranch info)) bl
| Tif (f1, f2, f3) -> | Tif (f1, f2, f3) ->
fprintf fmt (protect_on opr "IF %a@ THEN %a@ ELSE %a ENDIF") fprintf fmt (protect_on opr "IF %a@ THEN %a@ ELSE %a ENDIF")
(print_fmla info) f1 (print_fmla info) f2 (print_opl_fmla info) f3 (print_fmla info) f1 (print_fmla info) f2 (print_opl_fmla info) f3
...@@ -425,17 +423,29 @@ and print_tuple_pat info t fmt p = ...@@ -425,17 +423,29 @@ and print_tuple_pat info t fmt p =
in in
print_comma_list print fmt l print_comma_list print fmt l
and print_tbranch info fmt br = and print_branch print info fmt br =
let p,t = t_open_branch br in let p,t = t_open_branch br in
fprintf fmt "@[<hov 4> %a:@ %a@]" fprintf fmt "@[<hov 4> %a:@ %a@]"
(print_pat info) p (print_term info) t; (print_pat info) p (print info) t;
Svs.iter forget_var p.pat_vars Svs.iter forget_var p.pat_vars
and print_fbranch info fmt br = and print_branches ?(first=true) print info fmt = function
let p,f = t_open_branch br in | [] ->
fprintf fmt "@[<hov 4> %a:@ %a@]" ()
(print_pat info) p (print_fmla info) f; | br :: bl ->
Svs.iter forget_var p.pat_vars let p, t = t_open_branch br in
begin match p.pat_node with
| Pwild ->
assert (bl = []);
if not first then fprintf fmt "@\n";
fprintf fmt "@[<hov 4>ELSE@ %a@]" (print info) t
| _ ->
if not first then fprintf fmt ",@\n";
fprintf fmt "@[<hov 4> %a:@ %a@]"
(print_pat info) p (print info) t;
Svs.iter forget_var p.pat_vars;
print_branches ~first:false print info fmt bl
end
let print_expr info fmt = let print_expr info fmt =
TermTF.t_select (print_term info fmt) (print_fmla info fmt) TermTF.t_select (print_term info fmt) (print_fmla info fmt)
...@@ -715,12 +725,15 @@ let print_recursive_decl info fmt dl = ...@@ -715,12 +725,15 @@ let print_recursive_decl info fmt dl =
let print_ind info fmt (pr,f) = let print_ind info fmt (pr,f) =
fprintf fmt "@[%% %a:@\n(%a)@]" print_pr pr (print_fmla info) f fprintf fmt "@[%% %a:@\n(%a)@]" print_pr pr (print_fmla info) f
let print_ind_decl info fmt (ps,bl) = let print_ind_decl info fmt (ps,al) =
let _ty_vars_args, _ty_vars_value, all_ty_params = ls_ty_vars ps in let _ty_vars_args, _ty_vars_value, all_ty_params = ls_ty_vars ps in
let vl = List.map (create_vsymbol (id_fresh "z")) ps.ls_args in
let tl = List.map t_var vl in
let dj = Util.map_join_left (Eliminate_inductive.exi tl) t_or al in
fprintf fmt "@[<hov 2>%a%a(%a): INDUCTIVE bool =@ @[<hov>%a@]@]@\n" fprintf fmt "@[<hov 2>%a%a(%a): INDUCTIVE bool =@ @[<hov>%a@]@]@\n"
print_ls ps print_implicit_params all_ty_params print_ls ps print_implicit_params all_ty_params
(print_comma_list (print_ty info)) ps.ls_args (print_comma_list (print_vsty_nopar info)) vl
(print_or_list (print_ind info)) bl; (print_fmla info) dj;
fprintf fmt "@\n" fprintf fmt "@\n"
let print_ind_decl info fmt d = let print_ind_decl info fmt d =
......
...@@ -19,3 +19,5 @@ ...@@ -19,3 +19,5 @@
val eliminate_inductive : Task.task Trans.trans val eliminate_inductive : Task.task Trans.trans
(* exported to be used in the PVS printer *)
val exi: Term.term list -> 'a * Term.term -> Term.term
...@@ -3,7 +3,6 @@ theory TestPVS ...@@ -3,7 +3,6 @@ theory TestPVS
use import int.Int use import int.Int
(***
function f int : int function f int : int
axiom f_def: forall x: int. f(x) = x+1 axiom f_def: forall x: int. f(x) = x+1
...@@ -16,9 +15,8 @@ theory TestPVS ...@@ -16,9 +15,8 @@ theory TestPVS
goal G1: match g 1 with goal G1: match g 1 with
| A x ((y,z) as p) -> y=1+1 /\ p = (2,3) | A x ((y,z) as p) -> y=1+1 /\ p = (2,3)
| B (() as p) -> p=() | _ -> false
| C -> false end end
***)
type elt type elt
type tree = Null | Node tree elt tree type tree = Null | Node tree elt tree
...@@ -43,14 +41,10 @@ theory TestPVS ...@@ -43,14 +41,10 @@ theory TestPVS
| Node l _ r -> size2 l + size2 r + 1 | Node l _ r -> size2 l + size2 r + 1
end end
type u = t
with t = A | B u
(*
inductive even int = inductive even int =
| even0: even 0 | even0: even 0
| evens: forall n: int. even n -> even (n+2) | even2: forall n: int. even n -> even (n+2)
*) | even4: forall n: int. even n -> even (n+4)
lemma size_nonneg: forall t: tree. size t >= 0 lemma size_nonneg: forall t: tree. size t >= 0
......
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