Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

fm 2012, pbm 3 (in progress)

parent 804f893a
......@@ -16,26 +16,22 @@ module Memory
type node = { left: pointer; right: pointer; data: int; }
type memory = map pointer node
function get_left (m: memory) (p: pointer) : pointer = (get m p).left
function get_right (m: memory) (p: pointer) : pointer = (get m p).right
function get_data (m: memory) (p: pointer) : int = (get m p).data
(* 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) =
requires { p <> null }
ensures { result = (get !mem p).left }
(get !mem p).left
ensures { result = !mem[p].left }
!mem[p].left
let get_right (p: pointer) =
requires { p <> null }
ensures { result = (get !mem p).right }
(get !mem p).right
ensures { result = !mem[p].right }
!mem[p].right
let get_data (p: pointer) =
requires { p <> null }
ensures { result = (get !mem p).data }
(get !mem p).data
ensures { result = !mem[p].data }
!mem[p].data
end
......@@ -44,7 +40,6 @@ module Treedel
use import Memory
use import bintree.Tree
use import bintree.Inorder
use import bintree.Zipper
use import list.Distinct
(* there is a binary tree t rooted at p in memory m *)
......@@ -52,25 +47,27 @@ module Treedel
| leaf: forall m: memory. tree m null Empty
| node: forall m: memory, p: pointer, l r: tree pointer.
p <> null ->
tree m (get_left m p) l ->
tree m (get_right m p) r ->
tree m m[p].left l ->
tree m m[p].right r ->
tree m p (Node l p r)
(*
lemma frame:
forall m1: memory, p: pointer.
let n = get m1 p in
let m2 = set m1 p { n with left = (get m1 n.left).right } in
forall q: pointer. tree m1 q -> tree m2 q
(* degenerated zipper for a left descent *)
type zipper 'a =
| Top
| Left (zipper 'a) 'a (tree 'a)
function zip (t: tree 'a) (z: zipper 'a) : tree 'a = match z with
| Top -> t
| Left z x r -> zip (Node t x r) z
end
function leaves (m: memory) (p: pointer) : list pointer
lemma inorder_zip:
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))
axiom leaves_null: forall m: memory. leaves m null = Nil
axiom leaves_node:
forall m: memory, p: pointer. tree m p -> p <> null ->
leaves m p =
leaves m (get_left m p) ++ (Cons p Nil) ++ leaves m (get_right m p)
*)
lemma zip_bottom_left:
forall x: 'a, r: tree 'a, z: zipper 'a.
inorder (zip (Node Empty x r) z) = Cons x (inorder (zip r z))
let left (t: tree pointer) =
requires { t <> Empty }
......@@ -82,45 +79,55 @@ module Treedel
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, r: tree pointer, z: zipper pointer.
let it = zip (Node Empty p r) z in
tree m t it ->
distinct (inorder it) ->
m[pp].left = p ->
let m' = m[pp <- { m[pp] with left = m[p].right }] in
tree m' t (zip r z)
(* specification is as follows: if t is a tree and its list of pointers
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 x: pointer) (ghost gt: tree pointer) =
(t: pointer) (ghost it: tree pointer) (ghost ot: ref (tree pointer)) =
requires { t <> null }
requires { tree !mem t gt }
requires { match inorder gt with
requires { tree !mem t it }
requires { distinct (inorder it) }
ensures { let (t, m) = result in tree !mem t !ot /\
match inorder it with
| Nil -> false
| Cons p l -> p = x /\ distinct (Cons p l) end }
(*
ensures { let (t, m) = result in
tree !mem t /\ leaves !mem t = l /\ m = get_data !mem x }
*)
| Cons p l -> m = !mem[p].data /\ inorder !ot = l end }
let p = ref (get_left t) in
if !p = null then begin
let m = get_data t in
let tt = get_right t in
ghost match it with Empty -> absurd
| Node l _ r -> assert { l = Empty }; ot := r end;
(tt, m)
end else begin
let pp = ref t in
let tt = ref (get_left !p) in
let ghost zipper = ref (Left Top t (right gt)) in
let ghost subtree = ref (left gt) in
let ghost zipper = ref (Left Top t (right it)) in
let ghost subtree = ref (left it) in
while !tt <> null do
invariant {
(* tree !mem !pp /\
leaves !mem t = leaves !mem !pp ++ !suffix /\ *)
!pp <> null /\ get_left !mem !pp = !p /\
!p <> null /\ get_left !mem !p = !tt }
zipper := Left !zipper !p (right !subtree);
subtree := left !subtree;
invariant { !pp <> null /\ !mem[!pp].left = !p /\
!p <> null /\ !mem[!p].left = !tt /\
tree !mem !p !subtree /\
zip !subtree !zipper = it }
ghost match !subtree with
| Empty -> absurd
| Node l _ r -> zipper := Left !zipper !p r; subtree := l end;
pp := !p;
p := !tt;
tt := get_left !p
done;
assert { !p = x };
let m = get_data !p in
tt := get_right !p;
mem := set !mem !pp { (get !mem !pp) with left = !tt };
mem := set !mem !pp { !mem[!pp] with left = !tt };
ghost match !subtree with Empty -> absurd
| Node l _ r -> assert { l = Empty }; ot := zip r !zipper end;
(t, m)
end
......
This diff is collapsed.
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