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.
(* insert if it is new *)
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 tree_inb (x: key) (s: tree) : bool :=
match s with
| E => false
| T a y v' b => if  x <? y then tree_inb x a
else if y <? x then tree_inb x b
else true
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 tree_inb {V} x s.
Arguments pushdown_left {V} a bc.
Arguments delete {V} x s.
Fixpoint treebox_rep (t: tree val) (b: val) : mpred :=
match t with
| E => data_at Tsh (tptr t_struct_tree) nullval b
| T l x p r =>
!! (Int.min_signed <= x <= Int.max_signed) &&
data_at Tsh (tptr t_struct_tree) p b *
field_at Tsh t_struct_tree [StructField _key] (Vint (Int.repr x)) p *
treebox_rep l (field_address t_struct_tree [StructField _left] p) *
treebox_rep r (field_address t_struct_tree [StructField _right] p)
end.
Fixpoint key_store (s: tree val) (x: key) (q: val): Prop :=
match s with
| E => False
| T a y p b => if  x <? y then key_store a x q
else if y <? x then key_store b x q
else q = field_address t_struct_tree [StructField _value] p
end.
Definition key_store_ (s: tree val) (x: key): Prop :=
exists v, key_store s x v.
Definition value_at (t: tree val) (v: val) (x: Z): mpred :=
EX q: val,
!! (key_store t x q) &&
data_at Tsh (tptr Tvoid) v q.
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 treebox_new_spec :=
DECLARE _treebox_new
WITH u : unit
PRE  [  ]
PROP() LOCAL() SEP ()
POST [ (tptr t_struct_tree) ]
EX v:val,
PROP()
LOCAL(temp ret_temp v)
SEP (data_at Tsh (tptr t_struct_tree) nullval v).
Definition subscr_spec :=
DECLARE _subscr
WITH b: val, x: Z, t: tree val
PRE  [ _t OF (tptr (tptr t_struct_tree)), _key OF tint]
PROP(Int.min_signed <= x <= Int.max_signed)
LOCAL(temp _t b; temp _key (Vint (Int.repr x)))
SEP (treebox_rep t b)
POST [ tptr (tptr tvoid) ]
EX p: val, EX q: val,
PROP(key_store (insert x p t) x q)
LOCAL(temp ret_temp q)
SEP (treebox_rep (insert x p t) b;
(!! key_store_ t x && emp) || (!! (~ key_store_ t x) && data_at Tsh (tptr tvoid) nullval q)).
(* Definition subscr_spec1 := DECLARE _subscr WITH b: val, x: Z, p: val, xs: Z -> Prop PRE  [ _t OF (tptr (tptr t_struct_tree)), _key OF tint] PROP(xs x) LOCAL(temp _t b; temp _key (Vint (Int.repr x))) SEP (container_at xs b; key_store x p) POST [ Tvoid ] PROP() LOCAL() SEP (container_at xs b; key_store x p).  Definition subscr_spec2 := DECLARE _subscr WITH b: val, x: Z, p: val, xs: Z -> Prop PRE  [ _t OF (tptr (tptr t_struct_tree)), _key OF tint] PROP(~ xs x; Int.min_signed <= x <= Int.max_signed) LOCAL(temp _t b; temp _key (Vint (Int.repr x))) SEP (container_at xs b) POST [ Tvoid ] PROP() LOCAL() SEP (container_at (fun x0 => xs x0 \/ x0 = x) b; key_store x p). *)
Definition turn_left_spec :=
DECLARE _turn_left
WITH ta: tree val, x: Z, tb: tree val, y: Z, tc: tree val, b: val, l: val, r: val
PRE  [ __l OF (tptr (tptr (Tstruct _tree noattr))),
_l OF (tptr (Tstruct _tree noattr)),
_r OF (tptr (Tstruct _tree noattr))]
PROP()
LOCAL(temp __l b; temp _l l; temp _r r)
SEP (treebox_rep (T ta x l (T tb y r tc)) b)
POST [ Tvoid ]
PROP()
LOCAL()
SEP (treebox_rep (T (T ta x l tb) y r tc) b).
Definition pushdown_left_spec :=
DECLARE _pushdown_left
WITH ta: tree val, x: Z, tb: tree val, b: val, p: val
PRE  [ _t OF (tptr (tptr (Tstruct _tree noattr)))]
PROP()
LOCAL(temp _t b)
SEP (treebox_rep (T ta x p tb) b)
POST [ Tvoid ]
PROP()
LOCAL()
SEP (treebox_rep (pushdown_left ta tb) b).
(* Definition delete_spec1 := DECLARE _delete WITH b: val, x: Z, xs: Z -> Prop PRE  [ _t OF (tptr (tptr t_struct_tree)), _x OF tint] PROP(xs x) LOCAL(temp _t b; temp _x (Vint (Int.repr x))) SEP (container_at xs b; value_at Vundef x) POST [ Tvoid ] PROP() LOCAL() SEP (container_at (fun x0 => xs x0 /\ x0 <> x) b).  Definition delete_spec2 := DECLARE _delete WITH b: val, x: Z, xs: Z -> Prop PRE  [ _t OF (tptr (tptr t_struct_tree)), _x OF tint] PROP(~ xs x) LOCAL(temp _t b; temp _x (Vint (Int.repr x))) SEP (container_at xs b) POST [ Tvoid ] PROP() LOCAL() SEP (container_at xs b). *)
(* Definition tree_free_spec := DECLARE _tree_free WITH t: tree val, p: val PRE  [ _p OF (tptr t_struct_tree) ] PROP() LOCAL(temp _p p) SEP (tree_rep t p) POST [ Tvoid ] PROP() LOCAL() SEP (emp).  Definition treebox_free_spec := DECLARE _treebox_free WITH t: tree val, b: val PRE  [ _b OF (tptr (tptr t_struct_tree)) ] PROP() LOCAL(temp _b b) SEP (treebox_rep t b) POST [ Tvoid ] PROP() LOCAL() SEP (emp). *)
Definition Gprog : funspecs :=
ltac:(with_library prog [
mallocN_spec; freeN_spec; treebox_new_spec;
subscr_spec; turn_left_spec; pushdown_left_spec
]).
Hint Resolve treebox_rep_saturate_local: saturate_local.

(* Lemma tree_rep_saturate_local: forall t p, tree_rep t p |-- !! is_pointer_or_null p.  Hint Resolve tree_rep_saturate_local: saturate_local.  Lemma tree_rep_valid_pointer: forall t p, tree_rep t p |-- valid_pointer p. Hint Resolve tree_rep_valid_pointer: valid_pointer.  *)
Lemma modus_ponens_wand' {A}{ND: NatDed A}{SL: SepLog A}:
forall P Q R: A, P |-- Q -> P * (Q -* R) |-- R.