Commit 58d81b49 authored by MARCHE Claude's avatar MARCHE Claude

treedel example: a few renamings

type point -> loc
predicate tree -> istree
post-condition: t -> t'
parent 6847fe50
......@@ -12,7 +12,7 @@ Iterative deletion in a binary search tree - 90 minutes
VERIFICATION TASK
-----------------
Given: a pointer t to the root of a non-empty binary search tree (not
Given: a loc t to the root of a non-empty binary search tree (not
necessarily balanced). Verify that the following procedure removes the
node with the minimal key from the tree. After removal, the data
structure should again be a binary search tree.
......@@ -38,30 +38,30 @@ Note: When implementing in a garbage-collected language, the call to
dispose() is superfluous.
*)
(* Why3 has no pointer data structures, so we model the heap *)
(* Why3 has no loc data structures, so we model the heap *)
module Memory
use export map.Map
use export ref.Ref
type pointer
constant null: pointer
type node = { left: pointer; right: pointer; data: int; }
type memory = map pointer node
type loc
constant null: loc
type node = { left: loc; right: loc; data: int; }
type memory = map loc node
(* the global variable mem contains the current state of the memory *)
val mem: ref memory
(* accessor functions to ensure safety i.e. no null pointer dereference *)
let get_left (p: pointer) : pointer =
(* accessor functions to ensure safety i.e. no null loc dereference *)
let get_left (p: loc) : loc =
requires { p <> null }
ensures { result = !mem[p].left }
!mem[p].left
let get_right (p: pointer) : pointer =
let get_right (p: loc) : loc =
requires { p <> null }
ensures { result = !mem[p].right }
!mem[p].right
let get_data (p: pointer) : int =
let get_data (p: loc) : int =
requires { p <> null }
ensures { result = !mem[p].data }
!mem[p].data
......@@ -76,14 +76,14 @@ module Treedel
use import list.Distinct
(* there is a binary tree t rooted at p in memory m *)
inductive tree (m: memory) (p: pointer) (t: tree pointer) =
inductive istree (m: memory) (p: loc) (t: tree loc) =
| leaf: forall m: memory.
tree m null Empty
| node: forall m: memory, p: pointer, l r: tree pointer.
istree m null Empty
| node: forall m: memory, p: loc, l r: tree loc.
p <> null ->
tree m m[p].left l ->
tree m m[p].right r ->
tree m p (Node l p r)
istree m m[p].left l ->
istree m m[p].right r ->
istree m p (Node l p r)
(* degenerated zipper for a left descent (= list of pairs) *)
type zipper 'a =
......@@ -99,32 +99,32 @@ module Treedel
forall z "induction": zipper 'a, x: 'a, l r: tree 'a.
inorder (zip (Node l x r) z) = inorder l ++ Cons x (inorder (zip r z))
let ghost left (t: tree pointer) =
let ghost left (t: tree loc) =
requires { t <> Empty }
ensures { match t with Empty -> false | Node l _ _ -> result = l end }
match t with Empty -> absurd | Node l _ _ -> l end
let ghost right (t: tree pointer) =
let ghost right (t: tree loc) =
requires { t <> Empty }
ensures { match t with Empty -> false | Node _ _ r -> result = r end }
match t with Empty -> absurd | Node _ _ r -> r end
lemma main_lemma:
forall m: memory, t pp p: pointer, ppr pr: tree pointer, z: zipper pointer.
forall m: memory, t pp p: loc, ppr pr: tree loc, z: zipper loc.
let it = zip (Node (Node Empty p pr) pp ppr) z in
tree m t it -> distinct (inorder it) ->
istree m t it -> distinct (inorder it) ->
let m' = m[pp <- { m[pp] with left = m[p].right }] in
tree m' t (zip (Node pr pp ppr) z)
istree m' t (zip (Node pr pp ppr) z)
(* specification is as follows: if t is a tree and its list of pointers
(* specification is as follows: if t is a tree and its list of locs
is x::l then, at the end of execution, its list is l and m = x.data *)
let search_tree_delete_min
(t: pointer) (ghost it: tree pointer) (ghost ot: ref (tree pointer))
: (pointer, int)
(t: loc) (ghost it: tree loc) (ghost ot: ref (tree loc))
: (loc, int)
requires { t <> null }
requires { tree !mem t it }
requires { istree !mem t it }
requires { distinct (inorder it) }
ensures { let (t, m) = result in tree !mem t !ot /\
ensures { let (t', m) = result in istree !mem t' !ot /\
match inorder it with
| Nil -> false
| Cons p l -> m = !mem[p].data /\ inorder !ot = l end }
......@@ -146,8 +146,8 @@ module Treedel
invariant { !pp <> null /\ !mem[!pp].left = !p }
invariant { !p <> null /\ !mem[!p].left = !tt }
invariant { let pt = Node !subtree !pp !ppr in
tree !mem !pp pt /\ zip pt !zipper = it }
assert { tree !mem !p !subtree };
istree !mem !pp pt /\ zip pt !zipper = it }
assert { istree !mem !p !subtree };
ghost zipper := Left !zipper !pp !ppr;
ghost ppr := right !subtree;
ghost subtree := left !subtree;
......@@ -155,7 +155,7 @@ module Treedel
p := !tt;
tt := get_left !p
done;
assert { tree !mem !p !subtree };
assert { istree !mem !p !subtree };
assert { !pp <> !p };
let m = get_data !p in
tt := get_right !p;
......
......@@ -21,15 +21,15 @@ Definition contents {a:Type} {a_WT:WhyType a} (v:(ref a)): a :=
| (mk_ref x) => x
end.
Axiom pointer : Type.
Parameter pointer_WhyType : WhyType pointer.
Existing Instance pointer_WhyType.
Axiom loc : Type.
Parameter loc_WhyType : WhyType loc.
Existing Instance loc_WhyType.
Parameter null: pointer.
Parameter null: loc.
(* Why3 assumption *)
Inductive node :=
| mk_node : pointer -> pointer -> Z -> node.
| mk_node : loc -> loc -> Z -> node.
Axiom node_WhyType : WhyType node.
Existing Instance node_WhyType.
......@@ -39,19 +39,19 @@ Definition data (v:node): Z := match v with
end.
(* Why3 assumption *)
Definition right1 (v:node): pointer :=
Definition right1 (v:node): loc :=
match v with
| (mk_node x x1 x2) => x1
end.
(* Why3 assumption *)
Definition left1 (v:node): pointer :=
Definition left1 (v:node): loc :=
match v with
| (mk_node x x1 x2) => x
end.
(* Why3 assumption *)
Definition memory := (map.Map.map pointer node).
Definition memory := (map.Map.map loc node).
(* Why3 assumption *)
Inductive tree
......@@ -140,12 +140,12 @@ Axiom distinct_append : forall {a:Type} {a_WT:WhyType a}, forall (l1:(list
x l1) -> ~ (mem x l2)) -> (distinct (infix_plpl l1 l2)))).
(* Why3 assumption *)
Inductive tree1 : (map.Map.map pointer node) -> pointer -> (tree
pointer) -> Prop :=
| leaf : forall (m:(map.Map.map pointer node)), (tree1 m null (Empty :(tree
pointer)))
| node1 : forall (m:(map.Map.map pointer node)) (p:pointer) (l:(tree
pointer)) (r:(tree pointer)), (~ (p = null)) -> ((tree1 m
Inductive tree1 : (map.Map.map loc node) -> loc -> (tree
loc) -> Prop :=
| leaf : forall (m:(map.Map.map loc node)), (tree1 m null (Empty :(tree
loc)))
| node1 : forall (m:(map.Map.map loc node)) (p:loc) (l:(tree
loc)) (r:(tree loc)), (~ (p = null)) -> ((tree1 m
(left1 (map.Map.get m p)) l) -> ((tree1 m (right1 (map.Map.get m p))
r) -> (tree1 m p (Node l p r)))).
......@@ -171,9 +171,9 @@ Axiom inorder_zip : forall {a:Type} {a_WT:WhyType a}, forall (z:(zipper a))
(x:a) (l:(tree a)) (r:(tree a)), ((inorder (zip (Node l x r)
z)) = (infix_plpl (inorder l) (Cons x (inorder (zip r z))))).
Axiom main_lemma : forall (m:(map.Map.map pointer node)) (t:pointer)
(pp:pointer) (p:pointer) (ppr:(tree pointer)) (pr:(tree pointer))
(z:(zipper pointer)), let it := (zip (Node (Node (Empty :(tree pointer)) p
Axiom main_lemma : forall (m:(map.Map.map loc node)) (t:loc)
(pp:loc) (p:loc) (ppr:(tree loc)) (pr:(tree loc))
(z:(zipper loc)), let it := (zip (Node (Node (Empty :(tree loc)) p
pr) pp ppr) z) in ((tree1 m t it) -> ((distinct (inorder it)) -> (tree1
(map.Map.set m pp (mk_node (right1 (map.Map.get m p))
(right1 (map.Map.get m pp)) (data (map.Map.get m pp)))) t (zip (Node pr pp
......@@ -182,39 +182,39 @@ Axiom main_lemma : forall (m:(map.Map.map pointer node)) (t:pointer)
Require Import Why3. Ltac ae := why3 "alt-ergo" timelimit 3.
(* Why3 goal *)
Theorem WP_parameter_search_tree_delete_min : forall (t:pointer) (it:(tree
pointer)), forall (mem1:(map.Map.map pointer node)), (((~ (t = null)) /\
Theorem WP_parameter_search_tree_delete_min : forall (t:loc) (it:(tree
loc)), forall (mem1:(map.Map.map loc node)), (((~ (t = null)) /\
(tree1 mem1 t it)) /\ (distinct (inorder it))) -> ((~ (t = null)) ->
((~ ((left1 (map.Map.get mem1 t)) = null)) -> ((~ ((left1 (map.Map.get mem1
t)) = null)) -> ((~ (it = (Empty :(tree pointer)))) -> forall (o:(tree
pointer)), match it with
t)) = null)) -> ((~ (it = (Empty :(tree loc)))) -> forall (o:(tree
loc)), match it with
| Empty => False
| (Node _ _ r) => (o = r)
end -> ((~ (it = (Empty :(tree pointer)))) -> forall (o1:(tree pointer)),
end -> ((~ (it = (Empty :(tree loc)))) -> forall (o1:(tree loc)),
match it with
| Empty => False
| (Node l _ _) => (o1 = l)
end -> forall (subtree:(tree pointer)) (ppr:(tree pointer))
(zipper1:(zipper pointer)) (tt:pointer) (pp:pointer) (p:pointer),
end -> forall (subtree:(tree loc)) (ppr:(tree loc))
(zipper1:(zipper loc)) (tt:loc) (pp:loc) (p:loc),
((((~ (pp = null)) /\ ((left1 (map.Map.get mem1 pp)) = p)) /\
((~ (p = null)) /\ ((left1 (map.Map.get mem1 p)) = tt))) /\ let pt :=
(Node subtree pp ppr) in ((tree1 mem1 pp pt) /\ ((zip pt
zipper1) = it))) -> ((tt = null) -> ((tree1 mem1 p subtree) ->
((~ (pp = p)) -> ((~ (p = null)) -> ((~ (p = null)) ->
forall (tt1:pointer), (tt1 = (right1 (map.Map.get mem1 p))) ->
forall (mem2:(map.Map.map pointer node)), (mem2 = (map.Map.set mem1 pp
forall (tt1:loc), (tt1 = (right1 (map.Map.get mem1 p))) ->
forall (mem2:(map.Map.map loc node)), (mem2 = (map.Map.set mem1 pp
(mk_node tt1 (right1 (map.Map.get mem1 pp)) (data (map.Map.get mem1
pp))))) -> ((~ (subtree = (Empty :(tree pointer)))) -> forall (pl:(tree
pointer)),
pp))))) -> ((~ (subtree = (Empty :(tree loc)))) -> forall (pl:(tree
loc)),
match subtree with
| Empty => False
| (Node l _ _) => (pl = l)
end -> ((pl = (Empty :(tree pointer))) -> ((~ (subtree = (Empty :(tree
pointer)))) -> forall (o2:(tree pointer)),
end -> ((pl = (Empty :(tree loc))) -> ((~ (subtree = (Empty :(tree
loc)))) -> forall (o2:(tree loc)),
match subtree with
| Empty => False
| (Node _ _ r) => (o2 = r)
end -> forall (ot:(tree pointer)), (ot = (zip o2 (Left zipper1 pp ppr))) ->
end -> forall (ot:(tree loc)), (ot = (zip o2 (Left zipper1 pp ppr))) ->
match (inorder it) with
| Nil => True
| (Cons p1 l) => ((inorder ot) = l)
......
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