PVS printer in progress

fixed Coq printer on mutually recursive functions
parent 31285d48
...@@ -7,6 +7,7 @@ time "why3cpulimit time : %s s" ...@@ -7,6 +7,7 @@ time "why3cpulimit time : %s s"
transformation "inline_trivial" transformation "inline_trivial"
transformation "eliminate_builtin" transformation "eliminate_builtin"
transformation "eliminate_mutual_recursion"
transformation "eliminate_non_struct_recursion" transformation "eliminate_non_struct_recursion"
transformation "compile_match" transformation "compile_match"
...@@ -14,12 +15,16 @@ transformation "compile_match" ...@@ -14,12 +15,16 @@ transformation "compile_match"
transformation "simplify_formula" transformation "simplify_formula"
theory BuiltIn theory BuiltIn
syntax type int "int" syntax type int "int"
syntax type real "real" syntax type real "real"
syntax predicate (=) "(%1 = %2)" syntax predicate (=) "(%1 = %2)"
end end
theory Tuple0
syntax type tuple0 "tuple0"
syntax function Tuple0 "Tuple0"
end
theory bool.Bool theory bool.Bool
syntax type bool "bool" syntax type bool "bool"
......
...@@ -261,6 +261,6 @@ exec = "pvs" ...@@ -261,6 +261,6 @@ exec = "pvs"
version_switch = "-version" version_switch = "-version"
version_regexp = "PVS Version \\([^ \n]+\\)" version_regexp = "PVS Version \\([^ \n]+\\)"
version_ok = "5.0" version_ok = "5.0"
command = "@LOCALBIN@why3-cpulimit 0 %m -s %e -l %f" command = "@LOCALBIN@why3-cpulimit 0 %m -s proveit %f"
driver = "drivers/pvs.drv" driver = "drivers/pvs.drv"
editor = "pvs %f" editor = "pvs %f"
...@@ -162,8 +162,10 @@ let unambig_fs fs = ...@@ -162,8 +162,10 @@ let unambig_fs fs =
let lparen_l fmt () = fprintf fmt "@ (" let lparen_l fmt () = fprintf fmt "@ ("
let lparen_r fmt () = fprintf fmt "(@," let lparen_r fmt () = fprintf fmt "(@,"
let print_paren_l fmt x = print_list_delim lparen_l rparen comma fmt x let print_paren_l fmt x =
let print_paren_r fmt x = print_list_delim lparen_r rparen comma fmt x print_list_delim ~start:lparen_l ~stop:rparen ~sep:comma fmt x
let print_paren_r fmt x =
print_list_delim ~start:lparen_r ~stop:rparen ~sep:comma fmt x
let arrow fmt () = fprintf fmt "@ -> " let arrow fmt () = fprintf fmt "@ -> "
let print_arrow_list fmt x = print_list arrow fmt x let print_arrow_list fmt x = print_list arrow fmt x
...@@ -590,7 +592,7 @@ let print_recursive_decl info tm fmt (ls,ld) = ...@@ -590,7 +592,7 @@ let print_recursive_decl info tm fmt (ls,ld) =
begin match ld with begin match ld with
| Some ld -> | Some ld ->
let vl,e = open_ls_defn ld in let vl,e = open_ls_defn ld in
fprintf fmt "%a%a%a {struct %a}: %a :=@ %a.@]@\n" fprintf fmt "%a%a%a {struct %a}: %a :=@ %a@]"
print_ls ls print_ls ls
print_ne_params all_ty_params print_ne_params all_ty_params
(print_space_list (print_vsty info)) vl (print_space_list (print_vsty info)) vl
...@@ -604,15 +606,13 @@ let print_recursive_decl info tm fmt (ls,ld) = ...@@ -604,15 +606,13 @@ let print_recursive_decl info tm fmt (ls,ld) =
let print_recursive_decl info fmt dl = let print_recursive_decl info fmt dl =
let tm = check_termination dl in let tm = check_termination dl in
let d, dl = match dl with d :: dl -> d, dl | [] -> assert false in
fprintf fmt "Set Implicit Arguments.@\n"; fprintf fmt "Set Implicit Arguments.@\n";
fprintf fmt "@[<hov 2>Fixpoint "; print_list_delim
print_recursive_decl info tm fmt d; forget_tvs (); ~start:(fun fmt () -> fprintf fmt "@[<hov 2>Fixpoint ")
List.iter ~stop:(fun fmt () -> fprintf fmt ".@\n")
(fun d -> ~sep:(fun fmt () -> fprintf fmt "@\n@[<hov 2>with ")
fprintf fmt "@[<hov 2>with "; (fun fmt d -> print_recursive_decl info tm fmt d; forget_tvs ())
print_recursive_decl info tm fmt d; forget_tvs ()) fmt dl;
dl;
fprintf fmt "Unset Implicit Arguments.@\n@\n" fprintf fmt "Unset Implicit Arguments.@\n@\n"
let print_ind info fmt (pr,f) = let print_ind info fmt (pr,f) =
......
This diff is collapsed.
...@@ -43,7 +43,7 @@ let print_list_or_default default sep print fmt = function ...@@ -43,7 +43,7 @@ let print_list_or_default default sep print fmt = function
let print_list_par sep pr fmt l = let print_list_par sep pr fmt l =
print_list sep (fun fmt x -> fprintf fmt "(%a)" pr x) fmt l print_list sep (fun fmt x -> fprintf fmt "(%a)" pr x) fmt l
let print_list_delim start stop sep pr fmt = function let print_list_delim ~start ~stop ~sep pr fmt = function
| [] -> () | [] -> ()
| l -> fprintf fmt "%a%a%a" start () (print_list sep pr) l stop () | l -> fprintf fmt "%a%a%a" start () (print_list sep pr) l stop ()
......
...@@ -34,9 +34,9 @@ val print_list_par : ...@@ -34,9 +34,9 @@ val print_list_par :
(Format.formatter -> unit -> 'a) -> (Format.formatter -> unit -> 'a) ->
(Format.formatter -> 'b -> unit) -> Format.formatter -> 'b list -> unit (Format.formatter -> 'b -> unit) -> Format.formatter -> 'b list -> unit
val print_list_delim : val print_list_delim :
(Format.formatter -> unit -> unit) -> start:(Format.formatter -> unit -> unit) ->
(Format.formatter -> unit -> unit) -> stop:(Format.formatter -> unit -> unit) ->
(Format.formatter -> unit -> unit) -> sep:(Format.formatter -> unit -> unit) ->
(Format.formatter -> 'b -> unit) -> Format.formatter -> 'b list -> unit (Format.formatter -> 'b -> unit) -> Format.formatter -> 'b list -> unit
val print_pair_delim : val print_pair_delim :
......
theory TestConstant theory TestPVS
constant a : int use import int.Int
constant b : int
constant c : int
function f : int (***
function g : int function f int : int
predicate p axiom f_def: forall x: int. f(x) = x+1
goal G: a=0 && p goal G: forall x: int. f(x) > x
end
theory TestCoq type t = A int (int, int) | B () | C
use import list.List
use import list.Append
lemma append_nil: forall l: list 'a. Nil ++ l = l function g (x:int) : t = A x (x+1, x+2)
end
theory Bijection goal G1: match g 1 with
use export int.Int | A x ((y,z) as p) -> y=1+1 /\ p = (2,3)
function n : int | B (() as p) -> p=()
function f int : int | C -> false end
axiom dom_f : forall i: int. 0 <= i < n -> 0 <= f i < n ***)
function g int : int
axiom gf : forall i: int. 0 <= i < n -> g (f i) = i
end
theory Test1 type elt
function id (i: int) : int = i type tree = Null | Node tree elt tree
clone import Bijection with function f = id, lemma dom_f
goal G: n > 4 -> g (id 4) = 4 predicate contains (t: tree) (x: elt) = match t with
end | Null -> false
| Node l y r -> contains l x || x = y || contains r x
end
(* the size of a tree, to prove termination *)
function size (t: tree) : int = match t with
| Null -> 0
| Node l _ r -> size2 l + size2 r + 1
end
with size2 (t: tree) : int = match t with
| Null -> 0
| Node l _ r -> size l + size r + 1
end
function size3 (t: tree) : int = match t with
| Null -> 0
| Node l _ r -> size2 l + size2 r + 1
end
type u = t
with t = A | B u
(*
inductive even int =
| even0: even 0
| evens: forall n: int. even n -> even (n+2)
*)
theory Order lemma size_nonneg: forall t: tree. size t >= 0
type t
predicate (<=) t t
axiom le_refl : forall x : t. x <= x
axiom le_asym : forall x y : t. x <= y -> y <= x -> x = y
axiom le_trans: forall x y z : t. x <= y -> y <= z -> x <= z
end 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