new example: Problem 4 from VSTTE 12 competition

examples/programs/vstte12_tree_reconstruction.mlw

+
+(* The 2nd Verified Software Competition (VSTTE 2012) 
+   https://sites.google.com/site/vstte2012/compet
+
+   Problem 4: Tree Reconstruction
+   Build a binary tree from a list of leaf depths, if any
+
+   This is a purely applicative implementation, using immutable
+   lists from Why3's standard library.
+*)
+
+module TreeReconstruction
+
+  use import int.Int
+  use import list.List
+  use import list.Length
+  use import list.Append
+
+  type tree = Leaf | Node tree tree
+
+  (* the list of leaf depths for tree t, if root is at depth d *)
+  function depths (d: int) (t: tree) : list int = match t with
+    | Leaf -> Cons d Nil
+    | Node l r -> depths (d+1) l ++ depths (d+1) r
+  end
+
+  (* two lemmas on depths *)
+  lemma depths_head:
+    forall t: tree, d: int.
+    match depths d t with Cons x _ -> x >= d | Nil -> false end
+
+  lemma depths_unique:
+    forall t1 t2: tree, d: int, s1 s2: list int.
+    depths d t1 ++ s1 = depths d t2 ++ s2 -> t1 = t2 && s1 = s2
+
+  (* termination of build_rec (below) requires a lexicographic order *)
+  predicate lex (x1 x2: (list int, int)) =
+    let s1, d1 = x1 in
+    let s2, d2 = x2 in
+    length s1 < length s2 ||
+    length s1 = length s2 &&
+      match s1, s2 with
+      | Cons h1 _, Cons h2 _ -> d2 < d1 <= h1 = h2
+      | _ -> false
+      end
+
+  exception Failure
+    (* used to signal the algorithm's failure i.e. there is no tree *)
+
+  let rec build_rec (d: int) (s: list int) : (tree, list int)
+    variant { (s, d) } with lex =
+    { }
+    match s with
+    | Nil ->
+        raise Failure
+    | Cons h t ->
+        if h < d then raise Failure;
+        if h = d then
+          (Leaf, t)
+        else
+          let l, s = build_rec (d+1) s in
+          let r, s = build_rec (d+1) s in
+          (Node l r, s)
+    end
+    { let t, s' = result in s = depths d t ++ s' }
+    | Failure -> { forall t: tree, s' : list int. depths d t ++ s' <> s }
+
+  let build (s: list int) : tree =
+    { }
+    let t, s = build_rec 0 s in
+    match s with
+    | Nil -> t
+    | _ -> raise Failure
+    end
+    { depths 0 result = s }
+    | Failure -> { forall t: tree. depths 0 t <> s }
+
+end
+
+module Harness
+
+  use import list.List
+  use import module TreeReconstruction
+
+  let harness () =
+    {}
+    build (Cons 1 (Cons 3 (Cons 3 (Cons 2 Nil))))
+    { result = Node Leaf (Node (Node Leaf Leaf) Leaf) } | Failure -> { false }
+
+  let harness2 () =
+    {}
+    build (Cons 1 (Cons 3 (Cons 2 (Cons 2 Nil))))
+    { false } | Failure -> { true }
+
+end
+
+(*
+Local Variables:
+compile-command: "why3ide vstte12_tree_reconstruction.mlw"
+End:
+*)

examples/programs/vstte12_tree_reconstruction/vstte12_tree_reconstruction_WP_Harness_WP_parameter_harness2_1.v

+(* This file is generated by Why3's Coq driver *)
+(* Beware! Only edit allowed sections below    *)
+Require Import ZArith.
+Require Import Rbase.
+Definition unit  := unit.
+
+Parameter qtmark : Type.
+
+Parameter at1: forall (a:Type), a -> qtmark -> a.
+
+Implicit Arguments at1.
+
+Parameter old: forall (a:Type), a -> a.
+
+Implicit Arguments old.
+
+Definition implb(x:bool) (y:bool): bool := match (x,
+  y) with
+  | (true, false) => false
+  | (_, _) => true
+  end.
+
+Inductive list (a:Type) :=
+  | Nil : list a
+  | Cons : a -> (list a) -> list a.
+Set Contextual Implicit.
+Implicit Arguments Nil.
+Unset Contextual Implicit.
+Implicit Arguments Cons.
+
+Set Implicit Arguments.
+Fixpoint length (a:Type)(l:(list a)) {struct l}: Z :=
+  match l with
+  | Nil => 0%Z
+  | (Cons _ r) => (1%Z + (length r))%Z
+  end.
+Unset Implicit Arguments.
+
+Axiom Length_nonnegative : forall (a:Type), forall (l:(list a)),
+  (0%Z <= (length l))%Z.
+
+Axiom Length_nil : forall (a:Type), forall (l:(list a)),
+  ((length l) = 0%Z) <-> (l = (Nil:(list a))).
+
+Set Implicit Arguments.
+Fixpoint infix_plpl (a:Type)(l1:(list a)) (l2:(list a)) {struct l1}: (list
+  a) :=
+  match l1 with
+  | Nil => l2
+  | (Cons x1 r1) => (Cons x1 (infix_plpl r1 l2))
+  end.
+Unset Implicit Arguments.
+
+Axiom Append_assoc : forall (a:Type), forall (l1:(list a)) (l2:(list a))
+  (l3:(list a)), ((infix_plpl l1 (infix_plpl l2
+  l3)) = (infix_plpl (infix_plpl l1 l2) l3)).
+
+Axiom Append_l_nil : forall (a:Type), forall (l:(list a)), ((infix_plpl l
+  (Nil:(list a))) = l).
+
+Axiom Append_length : forall (a:Type), forall (l1:(list a)) (l2:(list a)),
+  ((length (infix_plpl l1 l2)) = ((length l1) + (length l2))%Z).
+
+Set Implicit Arguments.
+Fixpoint mem (a:Type)(x:a) (l:(list a)) {struct l}: Prop :=
+  match l with
+  | Nil => False
+  | (Cons y r) => (x = y) \/ (mem x r)
+  end.
+Unset Implicit Arguments.
+
+Axiom mem_append : forall (a:Type), forall (x:a) (l1:(list a)) (l2:(list a)),
+  (mem x (infix_plpl l1 l2)) <-> ((mem x l1) \/ (mem x l2)).
+
+Axiom mem_decomp : forall (a:Type), forall (x:a) (l:(list a)), (mem x l) ->
+  exists l1:(list a), exists l2:(list a), (l = (infix_plpl l1 (Cons x l2))).
+
+Inductive tree  :=
+  | Leaf : tree 
+  | Node : tree -> tree -> tree .
+
+Set Implicit Arguments.
+Fixpoint depths(d:Z) (t:tree) {struct t}: (list Z) :=
+  match t with
+  | Leaf => (Cons d (Nil:(list Z)))
+  | (Node l r) => (infix_plpl (depths (d + 1%Z)%Z l) (depths (d + 1%Z)%Z r))
+  end.
+Unset Implicit Arguments.
+
+Axiom depths_head : forall (t:tree) (d:Z), match (depths d
+  t) with
+  | (Cons x _) => (d <= x)%Z
+  | Nil => False
+  end.
+
+Axiom depths_unique : forall (t1:tree) (t2:tree) (d:Z) (s1:(list Z))
+  (s2:(list Z)), ((infix_plpl (depths d t1) s1) = (infix_plpl (depths d t2)
+  s2)) -> ((t1 = t2) /\ (s1 = s2)).
+
+Definition lex(x1:((list Z)* Z)%type) (x2:((list Z)* Z)%type): Prop :=
+  match x1 with
+  | (s1, d1) =>
+      match x2 with
+      | (s2, d2) => ((length s1) <  (length s2))%Z \/
+          (((length s1) = (length s2)) /\ match (s1,
+          s2) with
+          | ((Cons h1 _), (Cons h2 _)) => ((d2 <  d1)%Z /\ (d1 <= h1)%Z) /\
+              (h1 = h2)
+          | _ => False
+          end)
+      end
+  end.
+
+(* YOU MAY EDIT THE CONTEXT BELOW *)
+Lemma depths_length: 
+  forall t d, (length (depths d t) >= 1)%Z.
+Proof.
+  induction t; simpl; intuition.
+  rewrite Append_length.
+  generalize (IHt1 (d+1))%Z.
+  generalize (IHt2 (d+1))%Z.
+  omega.
+Qed.
+
+(* DO NOT EDIT BELOW *)
+
+Theorem WP_parameter_harness2 : forall (result:tree), ~ ((depths 0%Z
+  result) = (Cons 1%Z (Cons 3%Z (Cons 2%Z (Cons 2%Z (Nil:(list Z))))))).
+(* YOU MAY EDIT THE PROOF BELOW *)
+intuition.
+destruct result; simpl in H.
+discriminate H.
+destruct result1; simpl in H.
+injection H. intro H1.
+destruct result2; simpl in H1.
+discriminate H1.
+destruct result2_1; simpl in H1.
+discriminate H1.
+destruct result2_1_1; simpl in H1.
+injection H1. intro H2.
+destruct result2_1_2; simpl in H2.
+discriminate H2.
+clear H H1.
+generalize (depths_length result2_1_2_1 4).
+generalize (depths_length result2_1_2_2 4).
+generalize (depths_length result2_2 2).
+generalize (@f_equal _ _ (@length Z) _ _ H2).
+simpl.
+do 2 (rewrite Append_length).
+omega.
+(* 4 trees, 3 ints *)
+clear H.
+generalize (depths_length result2_1_1_1 4).
+generalize (depths_length result2_1_1_2 4).
+generalize (depths_length result2_1_2 3).
+generalize (depths_length result2_2 2).
+generalize (@f_equal _ _ (@length Z) _ _ H1).
+simpl.
+do 3 (rewrite Append_length).
+omega.
+
+destruct result1_1; simpl in H.
+discriminate H.
+destruct result1_1_1; simpl in H.
+discriminate H.
+(* 5 trees, 4 ints *)
+generalize (depths_length result1_1_1_1 4).
+generalize (depths_length result1_1_1_2 4).
+generalize (depths_length result1_1_2 3).
+generalize (depths_length result1_2 2).
+generalize (depths_length result2 1).
+generalize (@f_equal _ _ (@length Z) _ _ H).
+simpl.
+do 4 (rewrite Append_length).
+omega.
+
+Qed.
+(* DO NOT EDIT BELOW *)
+
+

examples/programs/vstte12_tree_reconstruction/vstte12_tree_reconstruction_WP_Harness_WP_parameter_harness_1.v

+(* This file is generated by Why3's Coq driver *)
+(* Beware! Only edit allowed sections below    *)
+Require Import ZArith.
+Require Import Rbase.
+Definition unit  := unit.
+
+Parameter qtmark : Type.
+
+Parameter at1: forall (a:Type), a -> qtmark -> a.
+
+Implicit Arguments at1.
+
+Parameter old: forall (a:Type), a -> a.
+
+Implicit Arguments old.
+
+Definition implb(x:bool) (y:bool): bool := match (x,
+  y) with
+  | (true, false) => false
+  | (_, _) => true
+  end.
+
+Inductive list (a:Type) :=
+  | Nil : list a
+  | Cons : a -> (list a) -> list a.
+Set Contextual Implicit.
+Implicit Arguments Nil.
+Unset Contextual Implicit.
+Implicit Arguments Cons.
+
+Set Implicit Arguments.
+Fixpoint length (a:Type)(l:(list a)) {struct l}: Z :=
+  match l with
+  | Nil => 0%Z
+  | (Cons _ r) => (1%Z + (length r))%Z
+  end.
+Unset Implicit Arguments.
+
+Axiom Length_nonnegative : forall (a:Type), forall (l:(list a)),
+  (0%Z <= (length l))%Z.
+
+Axiom Length_nil : forall (a:Type), forall (l:(list a)),
+  ((length l) = 0%Z) <-> (l = (Nil:(list a))).
+
+Set Implicit Arguments.
+Fixpoint infix_plpl (a:Type)(l1:(list a)) (l2:(list a)) {struct l1}: (list
+  a) :=
+  match l1 with
+  | Nil => l2
+  | (Cons x1 r1) => (Cons x1 (infix_plpl r1 l2))
+  end.
+Unset Implicit Arguments.
+
+Axiom Append_assoc : forall (a:Type), forall (l1:(list a)) (l2:(list a))
+  (l3:(list a)), ((infix_plpl l1 (infix_plpl l2
+  l3)) = (infix_plpl (infix_plpl l1 l2) l3)).
+
+Axiom Append_l_nil : forall (a:Type), forall (l:(list a)), ((infix_plpl l
+  (Nil:(list a))) = l).
+
+Axiom Append_length : forall (a:Type), forall (l1:(list a)) (l2:(list a)),
+  ((length (infix_plpl l1 l2)) = ((length l1) + (length l2))%Z).
+
+Set Implicit Arguments.
+Fixpoint mem (a:Type)(x:a) (l:(list a)) {struct l}: Prop :=
+  match l with
+  | Nil => False
+  | (Cons y r) => (x = y) \/ (mem x r)
+  end.
+Unset Implicit Arguments.
+
+Axiom mem_append : forall (a:Type), forall (x:a) (l1:(list a)) (l2:(list a)),
+  (mem x (infix_plpl l1 l2)) <-> ((mem x l1) \/ (mem x l2)).
+
+Axiom mem_decomp : forall (a:Type), forall (x:a) (l:(list a)), (mem x l) ->
+  exists l1:(list a), exists l2:(list a), (l = (infix_plpl l1 (Cons x l2))).
+
+Inductive tree  :=
+  | Leaf : tree 
+  | Node : tree -> tree -> tree .
+
+Set Implicit Arguments.
+Fixpoint depths(d:Z) (t:tree) {struct t}: (list Z) :=
+  match t with
+  | Leaf => (Cons d (Nil:(list Z)))
+  | (Node l r) => (infix_plpl (depths (d + 1%Z)%Z l) (depths (d + 1%Z)%Z r))
+  end.
+Unset Implicit Arguments.
+
+Axiom depths_head : forall (t:tree) (d:Z), match (depths d
+  t) with
+  | (Cons x _) => (d <= x)%Z
+  | Nil => False
+  end.
+
+Axiom depths_unique : forall (t1:tree) (t2:tree) (d:Z) (s1:(list Z))
+  (s2:(list Z)), ((infix_plpl (depths d t1) s1) = (infix_plpl (depths d t2)
+  s2)) -> ((t1 = t2) /\ (s1 = s2)).
+
+Definition lex(x1:((list Z)* Z)%type) (x2:((list Z)* Z)%type): Prop :=
+  match x1 with
+  | (s1, d1) =>
+      match x2 with
+      | (s2, d2) => ((length s1) <  (length s2))%Z \/
+          (((length s1) = (length s2)) /\ match (s1,
+          s2) with
+          | ((Cons h1 _), (Cons h2 _)) => ((d2 <  d1)%Z /\ (d1 <= h1)%Z) /\
+              (h1 = h2)
+          | _ => False
+          end)
+      end
+  end.
+
+(* YOU MAY EDIT THE CONTEXT BELOW *)
+
+(* DO NOT EDIT BELOW *)
+
+Theorem WP_parameter_harness : forall (result:tree), ((depths 0%Z
+  result) = (Cons 1%Z (Cons 3%Z (Cons 3%Z (Cons 2%Z (Nil:(list Z))))))) ->
+  (result = (Node Leaf (Node (Node Leaf Leaf) Leaf))).
+(* YOU MAY EDIT THE PROOF BELOW *)
+intuition.
+
+rewrite <- (Append_l_nil _ (depths 0 result)) in H.
+rewrite <- (Append_l_nil _ (Cons 1%Z (Cons 3%Z (Cons 3%Z (Cons 2%Z Nil))))) in H.
+replace (Cons 1%Z (Cons 3%Z (Cons 3%Z (Cons 2%Z Nil)))) with
+   (depths 0 (Node Leaf (Node (Node Leaf Leaf) Leaf))) in H by reflexivity.
+generalize (depths_unique _ _ _ _ _ H); intuition.
+
+Qed.
+(* DO NOT EDIT BELOW *)
+
+

examples/programs/vstte12_tree_reconstruction/vstte12_tree_reconstruction_WP_Harness_WP_parameter_harness_2.v

+(* This file is generated by Why3's Coq driver *)
+(* Beware! Only edit allowed sections below    *)
+Require Import ZArith.
+Require Import Rbase.
+Definition unit  := unit.
+
+Parameter qtmark : Type.
+
+Parameter at1: forall (a:Type), a -> qtmark -> a.
+
+Implicit Arguments at1.
+
+Parameter old: forall (a:Type), a -> a.
+
+Implicit Arguments old.
+
+Definition implb(x:bool) (y:bool): bool := match (x,
+  y) with
+  | (true, false) => false
+  | (_, _) => true
+  end.
+
+Inductive list (a:Type) :=
+  | Nil : list a
+  | Cons : a -> (list a) -> list a.
+Set Contextual Implicit.
+Implicit Arguments Nil.
+Unset Contextual Implicit.
+Implicit Arguments Cons.
+
+Set Implicit Arguments.
+Fixpoint length (a:Type)(l:(list a)) {struct l}: Z :=
+  match l with
+  | Nil => 0%Z
+  | (Cons _ r) => (1%Z + (length r))%Z
+  end.
+Unset Implicit Arguments.
+
+Axiom Length_nonnegative : forall (a:Type), forall (l:(list a)),
+  (0%Z <= (length l))%Z.
+
+Axiom Length_nil : forall (a:Type), forall (l:(list a)),
+  ((length l) = 0%Z) <-> (l = (Nil:(list a))).
+
+Set Implicit Arguments.
+Fixpoint infix_plpl (a:Type)(l1:(list a)) (l2:(list a)) {struct l1}: (list
+  a) :=
+  match l1 with
+  | Nil => l2
+  | (Cons x1 r1) => (Cons x1 (infix_plpl r1 l2))
+  end.
+Unset Implicit Arguments.
+
+Axiom Append_assoc : forall (a:Type), forall (l1:(list a)) (l2:(list a))
+  (l3:(list a)), ((infix_plpl l1 (infix_plpl l2
+  l3)) = (infix_plpl (infix_plpl l1 l2) l3)).
+
+Axiom Append_l_nil : forall (a:Type), forall (l:(list a)), ((infix_plpl l
+  (Nil:(list a))) = l).
+
+Axiom Append_length : forall (a:Type), forall (l1:(list a)) (l2:(list a)),
+  ((length (infix_plpl l1 l2)) = ((length l1) + (length l2))%Z).
+
+Set Implicit Arguments.
+Fixpoint mem (a:Type)(x:a) (l:(list a)) {struct l}: Prop :=
+  match l with
+  | Nil => False
+  | (Cons y r) => (x = y) \/ (mem x r)
+  end.
+Unset Implicit Arguments.
+
+Axiom mem_append : forall (a:Type), forall (x:a) (l1:(list a)) (l2:(list a)),
+  (mem x (infix_plpl l1 l2)) <-> ((mem x l1) \/ (mem x l2)).
+
+Axiom mem_decomp : forall (a:Type), forall (x:a) (l:(list a)), (mem x l) ->
+  exists l1:(list a), exists l2:(list a), (l = (infix_plpl l1 (Cons x l2))).
+
+Inductive tree  :=
+  | Leaf : tree 
+  | Node : tree -> tree -> tree .
+
+Set Implicit Arguments.
+Fixpoint depths(d:Z) (t:tree) {struct t}: (list Z) :=
+  match t with
+  | Leaf => (Cons d (Nil:(list Z)))
+  | (Node l r) => (infix_plpl (depths (d + 1%Z)%Z l) (depths (d + 1%Z)%Z r))
+  end.
+Unset Implicit Arguments.
+
+Axiom depths_head : forall (t:tree) (d:Z), match (depths d
+  t) with
+  | (Cons x _) => (d <= x)%Z
+  | Nil => False
+  end.
+
+Axiom depths_unique : forall (t1:tree) (t2:tree) (d:Z) (s1:(list Z))
+  (s2:(list Z)), ((infix_plpl (depths d t1) s1) = (infix_plpl (depths d t2)
+  s2)) -> ((t1 = t2) /\ (s1 = s2)).
+
+Definition lex(x1:((list Z)* Z)%type) (x2:((list Z)* Z)%type): Prop :=
+  match x1 with
+  | (s1, d1) =>
+      match x2 with
+      | (s2, d2) => ((length s1) <  (length s2))%Z \/
+          (((length s1) = (length s2)) /\ match (s1,
+          s2) with
+          | ((Cons h1 _), (Cons h2 _)) => ((d2 <  d1)%Z /\ (d1 <= h1)%Z) /\
+              (h1 = h2)
+          | _ => False
+          end)
+      end
+  end.
+
+(* YOU MAY EDIT THE CONTEXT BELOW *)
+
+(* DO NOT EDIT BELOW *)
+
+Theorem WP_parameter_harness : (forall (result:tree), ((depths 0%Z
+  result) = (Cons 1%Z (Cons 3%Z (Cons 3%Z (Cons 2%Z (Nil:(list Z))))))) ->
+  (result = (Node Leaf (Node (Node Leaf Leaf) Leaf)))) -> ~ forall (t:tree),
+  ~ ((depths 0%Z t) = (Cons 1%Z (Cons 3%Z (Cons 3%Z (Cons 2%Z (Nil:(list
+  Z))))))).
+(* YOU MAY EDIT THE PROOF BELOW *)
+intuition.
+apply (H0 (Node Leaf (Node (Node Leaf Leaf) Leaf))).
+reflexivity.
+Qed.