Section TREES.
Variable V : Type.
Variable default: V.
Definition key := Z.
Inductive tree : Type :=
| E : tree
| T: tree -> key -> V -> tree -> tree.
Definition empty_tree : tree := E.
Fixpoint insert (x: key) (v: V) (s: tree) : tree :=
match s with
| E => T E x v E
| T a y v' b => if  x <? y then T (insert x v a) y v' b
else if y <? x then T a y v' (insert x v b)
else T a x v b
end.
Fixpoint lookup (x: key) (t : tree) : V :=
match t with
| E => default
| T tl k v tr => if x <? k then lookup x tl
else if k <? x then lookup x tr
else v
end.
Fixpoint pushdown_left (a: tree) (bc: tree) : tree :=
match bc with
| E => a
| T b y vy c => T (pushdown_left a b) y vy c
end.
Fixpoint delete (x: key) (s: tree) : tree :=
match s with
| E => E
| T a y v' b => if  x <? y then T (delete x a) y v' b
else if y <? x then T a y v' (delete x b)
else pushdown_left a b
end.
End TREES.
Arguments E {V}.
Arguments T {V} _ _ _ _.
Arguments insert {V} x v s.
Arguments lookup {V} default x t.
Arguments pushdown_left {V} a bc.
Arguments delete {V} x s.
Fixpoint treebox_rep (t: tree val) (p: val) :=
EX q: val,
data_at Tsh (tptr t_struct_tree) q p *
match t with
| E => !!(q=nullval) && emp
| T l x v r => !! (Int.min_signed <= x <= Int.max_signed /\ tc_val (tptr Tvoid) v) &&
field_at Tsh t_struct_tree [StructField _key] (Vint (Int.repr x)) q *
field_at Tsh t_struct_tree [StructField _value] v q *
treebox_rep l (field_address t_struct_tree [StructField _left] q) *
treebox_rep r (field_address t_struct_tree [StructField _right] q)
end.
Definition tree_rep (t: tree val) (q: val) :=
match t with
| E => !!(q=nullval) && emp
| T l x v r => !! (Int.min_signed <= x <= Int.max_signed /\ tc_val (tptr Tvoid) v) &&
field_at Tsh t_struct_tree [StructField _key] (Vint (Int.repr x)) q *
field_at Tsh t_struct_tree [StructField _value] v q *
treebox_rep l (field_address t_struct_tree [StructField _left] q) *
treebox_rep r (field_address t_struct_tree [StructField _right] q)
end.
Definition mallocN_spec :=
DECLARE _mallocN
WITH n: Z
PRE [ 1%positive OF tint]
PROP (4 <= n <= Int.max_unsigned)
LOCAL (temp 1%positive (Vint (Int.repr n)))
SEP ()
POST [ tptr tvoid ]
EX v: val,
PROP (malloc_compatible n v)
LOCAL (temp ret_temp v)
SEP (memory_block Tsh n v).
Definition freeN_spec :=
DECLARE _freeN
WITH p : val , n : Z
PRE [ 1%positive OF tptr tvoid , 2%positive OF tint]
(* we should also require natural_align_compatible (eval_id 1) *)
PROP() LOCAL (temp 1%positive p; temp 2%positive (Vint (Int.repr n)))
SEP (memory_block Tsh n p)
POST [ tvoid ]
PROP () LOCAL () SEP ().
Definition insert_spec :=
DECLARE _insert
WITH p0: val, x: Z, v: val, t0: tree val
PRE  [ _p OF (tptr (tptr t_struct_tree)), _x OF tint,
_value OF (tptr Tvoid)   ]
PROP( Int.min_signed <= x <= Int.max_signed; is_pointer_or_null v)
LOCAL(temp _p p0; temp _x (Vint (Int.repr x)); temp _value v)
SEP (treebox_rep t0 p0)
POST [ Tvoid ]
PROP()
LOCAL()
SEP (treebox_rep (insert x v t0) p0).
Definition lookup_spec :=
DECLARE _lookup
WITH b: val, x: Z, v: val, t: tree val
PRE  [ _t OF (tptr (tptr t_struct_tree)), _x OF tint  ]
PROP( Int.min_signed <= x <= Int.max_signed)
LOCAL(temp _t b; temp _x (Vint (Int.repr x)))
SEP (treebox_rep t b)
POST [ tptr Tvoid ]
PROP()
LOCAL(temp ret_temp (lookup nullval x t))
SEP (treebox_rep t b).
(* Definition turn_left_spec := DECLARE _turn_left WITH ta: tree val, x: Z, vx: val, tb: tree val, y: Z, vy: val, tc: tree val, b: val, l: val, pa: val, r: val PRE  [ __l OF (tptr (tptr (Tstruct _tree noattr))), _l OF (tptr (Tstruct _tree noattr)), _r OF (tptr (Tstruct _tree noattr))] PROP(Int.min_signed <= x <= Int.max_signed; is_pointer_or_null vx) LOCAL(temp __l b; temp _l l; temp _r r) SEP (data_at Tsh (tptr t_struct_tree) l b; data_at Tsh t_struct_tree (Vint (Int.repr x), (vx, (pa, r))) l; tree_rep ta pa; tree_rep (T tb y vy tc) r) POST [ Tvoid ] EX pc: val, PROP(Int.min_signed <= y <= Int.max_signed; is_pointer_or_null vy) LOCAL() SEP (data_at Tsh (tptr t_struct_tree) r b; data_at Tsh t_struct_tree (Vint (Int.repr y), (vy, (l, pc))) r; tree_rep (T ta x vx tb) l; tree_rep tc pc).  Definition pushdown_left_spec := DECLARE _pushdown_left WITH ta: tree val, x: Z, v: val, tb: tree val, b: val, p: val PRE  [ _t OF (tptr (tptr (Tstruct _tree noattr)))] PROP(Int.min_signed <= x <= Int.max_signed; tc_val (tptr Tvoid) v) LOCAL(temp _t b) SEP (data_at Tsh (tptr t_struct_tree) p b; field_at Tsh t_struct_tree [StructField _key] (Vint (Int.repr x)) p; field_at Tsh t_struct_tree [StructField _value] v p; treebox_rep ta (field_address t_struct_tree [StructField _left] p); treebox_rep tb (field_address t_struct_tree [StructField _right] p)) POST [ Tvoid ] PROP() LOCAL() SEP (treebox_rep (pushdown_left ta tb) b).  Definition delete_spec := DECLARE _delete WITH b: val, x: Z, t: tree val PRE  [ _t OF (tptr (tptr t_struct_tree)), _x OF tint] PROP( Int.min_signed <= x <= Int.max_signed) LOCAL(temp _t b; temp _x (Vint (Int.repr x))) SEP (treebox_rep t b) POST [ Tvoid ] PROP() LOCAL() SEP (treebox_rep (delete x t) b). *)
Definition Gprog : funspecs :=
ltac:(with_library prog [
mallocN_spec; freeN_spec;
insert_spec; lookup_spec(*;
turn_left_spec; pushdown_left_spec; delete_spec*)
]).
Hint Resolve tree_rep_saturate_local: saturate_local.
Hint Resolve tree_rep_valid_pointer: valid_pointer.
Hint Resolve treebox_rep_saturate_local: saturate_local.
Definition insert_inv (p0: val) (t0: tree val) (x: Z) (v: val): environ -> mpred :=
EX p: val, EX t: tree val,
PROP()
LOCAL(temp _p p; temp _x (Vint (Int.repr x));   temp _value v)
SEP(treebox_rep t p;  (treebox_rep (insert x v t) p -* treebox_rep (insert x v t0) p0)).
Hint Resolve tree_rep_nullval: saturate_local.

(* Lemma bst_left_entail: forall (t1 t1' t2: tree val) k (v p1 p2 p b: val), Int.min_signed <= k <= Int.max_signed -> is_pointer_or_null v -> data_at Tsh (tptr t_struct_tree) p b * data_at Tsh t_struct_tree (Vint (Int.repr k), (v, (p1, p2))) p * tree_rep t1 p1 * tree_rep t2 p2 |-- treebox_rep t1 (field_address t_struct_tree [StructField _left] p) * (treebox_rep t1' (field_address t_struct_tree [StructField _left] p) -* treebox_rep (T t1' k v t2) b).  Lemma bst_right_entail: forall (t1 t2 t2': tree val) k (v p1 p2 p b: val), Int.min_signed <= k <= Int.max_signed -> is_pointer_or_null v -> data_at Tsh (tptr t_struct_tree) p b * data_at Tsh t_struct_tree (Vint (Int.repr k), (v, (p1, p2))) p * tree_rep t1 p1 * tree_rep t2 p2 |-- treebox_rep t2 (field_address t_struct_tree [StructField _right] p) * (treebox_rep t2' (field_address t_struct_tree [StructField _right] p) -* treebox_rep (T t1 k v t2') b).  Lemma modus_ponens_wand' {A}{ND: NatDed A}{SL: SepLog A}: forall P Q R: A, P |-- Q -> P * (Q -* R) |-- R. *)
Lemma if_trueb: forall {A: Type} b (a1 a2: A), b = true -> (if b then a1 else a2) = a1.