summaryrefslogtreecommitdiff
path: root/AvlVerification/Insert.lean
diff options
context:
space:
mode:
Diffstat (limited to 'AvlVerification/Insert.lean')
-rw-r--r--AvlVerification/Insert.lean95
1 files changed, 65 insertions, 30 deletions
diff --git a/AvlVerification/Insert.lean b/AvlVerification/Insert.lean
index 3c2b8b3..baf3441 100644
--- a/AvlVerification/Insert.lean
+++ b/AvlVerification/Insert.lean
@@ -7,9 +7,47 @@ namespace Implementation
open Primitives
open avl_verification
open Tree (AVLTree)
-open Specifications (OrdSpec ordSpecOfInfaillible ordOfOrdSpec ltOfRustOrder)
+open Specifications (OrdSpec ordSpecOfTotalityAndDuality ordOfOrdSpec ltOfRustOrder gtOfRustOrder)
+
+example: OrdSpec OrdU32 := ordSpecOfTotalityAndDuality _
+ (by
+ -- Totality
+ intro a b
+ unfold Ord.cmp
+ unfold OrdU32
+ unfold OrdU32.cmp
+ if hlt : a < b then
+ use .Less
+ simp [hlt]
+ else
+ if heq: a = b
+ then
+ use .Equal
+ simp [hlt]
+ rw [heq]
+ -- TODO: simp [hlt, heq] breaks everything???
+ else
+ use .Greater
+ simp [hlt, heq]
+ ) (by
+ -- Duality
+ intro a b Hgt
+ if hlt : b < a then
+ unfold Ord.cmp
+ unfold OrdU32
+ unfold OrdU32.cmp
+ simp [hlt]
+ else
+ unfold Ord.cmp at Hgt
+ unfold OrdU32 at Hgt
+ unfold OrdU32.cmp at Hgt
+ have hnlt : ¬ (a < b) := sorry
+ have hneq : ¬ (a = b) := sorry
+ exfalso
+ apply hlt
+ -- I need a Preorder on U32 now.
+ sorry)
--- TODO: OSpec should be proven.
variable (T: Type) (H: avl_verification.Ord T) (Ospec: @OrdSpec T H)
instance rustOrder {U: Type} {O: avl_verification.Ord U} (OSpec: OrdSpec O): _root_.Ord U := ordOfOrdSpec O OSpec
@@ -20,9 +58,9 @@ instance rustLt' : LT T := rustLt Ospec
@[pspec]
theorem AVLTreeSet.insert_loop_spec_local (p: T -> Prop)
- (Hcmp_spec: ∀ a b, ∃ o, H.cmp a b = Result.ret o)
+ (Hcmp_spec: ∀ a b, ∃ o, H.cmp a b = Result.ok o)
(a: T) (t: Option (AVLNode T)):
- ∃ added t_new, AVLTreeSet.insert_loop T H a t = Result.ret ⟨ added, t_new ⟩
+ ∃ added t_new, AVLTreeSet.insert_loop T H a t = Result.ok ⟨ added, t_new ⟩
-- ∧ AVLTree.set t'.2 = insert a (AVLTree.set t)
∧ (BST.ForallNode p t -> p a -> BST.ForallNode p t_new)
:= by match t with
@@ -68,8 +106,8 @@ lemma AVLTreeSet.insert_loop_spec_global
(a: T) (t: Option (AVLNode T))
:
haveI : LT T := (rustLt Ospec)
- BST.BST t -> ∃ added t_new, AVLTreeSet.insert_loop T H a t = Result.ret ⟨ added, t_new ⟩
- ∧ BST.BST t_new := by
+ BST.Invariant t -> ∃ added t_new, AVLTreeSet.insert_loop T H a t = Result.ok ⟨ added, t_new ⟩
+ ∧ BST.Invariant t_new := by
intro Hbst
letI instOrd : _root_.Ord T := (rustOrder Ospec)
letI instLt : LT T := (rustLt Ospec)
@@ -78,9 +116,7 @@ lemma AVLTreeSet.insert_loop_spec_global
| some (AVLNode.mk b left right) =>
rw [AVLTreeSet.insert_loop]
simp only []
- have := Ospec.infallible; simp at this
- -- TODO: unbundle `this`...
- have : ∀ a b, ∃ o, H.cmp a b = .ret o := sorry
+ have : ∀ a b, ∃ o, H.cmp a b = .ok o := Ospec.infallible
progress keep Hordering as ⟨ ordering ⟩
cases ordering
all_goals simp only []
@@ -104,34 +140,33 @@ lemma AVLTreeSet.insert_loop_spec_global
simp; tauto
}
{
- sorry
+ have ⟨ added₂, left₂, ⟨ H_result, H_bst ⟩ ⟩ := AVLTreeSet.insert_loop_spec_global a left (BST.left Hbst)
+ progress keep Htree with AVLTreeSet.insert_loop_spec_local as ⟨ added₁, left₁, Hnode ⟩
+ exact (fun x => x < b)
+ rewrite [Htree] at H_result; simp at H_result
+ refine' ⟨ added₁, ⟨ some (AVLNode.mk b left₁ right), _ ⟩ ⟩
+ simp only [true_and]
+ cases' Hbst with _ _ _ H_forall_left H_forall_right H_bst_left H_bst_right
+ constructor
+ apply Hnode; exact H_forall_left
+ exact (gtOfRustOrder H b a Hordering)
+ exact H_forall_right
+ convert H_bst
+ exact H_result.2
+ exact H_bst_right
}
@[pspec]
def AVLTreeSet.insert_spec
- {H: avl_verification.Ord T}
- -- TODO: this can be generalized into `H.cmp` must be an equivalence relation.
- -- and insert works no longer on Sets but on set quotiented by this equivalence relation.
- (Hcmp_eq: ∀ a b, H.cmp a b = Result.ret Ordering.Equal -> a = b)
- (Hcmp_spec: ∀ a b, ∃ o, H.cmp a b = Result.ret o)
- (Hbs_search: @BSTree.searchInvariant _ H t)
(a: T) (t: AVLTreeSet T):
- ∃ t', t.insert _ H a = Result.ret t'
- -- set of values *POST* insertion is {a} \cup set of values of the *PRE* tree.
- ∧ AVLTree.setOf t'.2.root = insert a (AVLTree.setOf t.root)
+ haveI : LT T := (rustLt Ospec)
+ BST.Invariant t.root -> (∃ t' added,t.insert _ H a = Result.ok (added, t')
-- it's still a binary search tree.
- ∧ @BSTree.searchInvariant _ H t'.2.root
- -- TODO(reinforcement): (t'.1 is false <=> a \in AVLTree.setOf t.root)
+ ∧ BST.Invariant t'.root)
:= by
- rw [AVLTreeSet.insert]
- progress keep h as ⟨ t', Hset ⟩; simp
- rw [Hset]
- sorry
-
-
--- insert is infaillible, right?
--- instance [LT T] (o: avl_verification.Ord T): Insert T (AVLTreeSet T) where
--- insert x tree := (AVLTreeSet.insert T o tree x).map (fun (added, tree) => tree)
+ rw [AVLTreeSet.insert]; intro Hbst
+ progress keep h as ⟨ t', Hset ⟩;
+ simp; assumption
end Implementation