Library topsy_hmAlloc3_old
Load seplog_header.
Require Import topsy_hm_old.
Require Import topsy_hmAlloc_old.
Print Free.
Fixpoint compact' (l:list (loc * nat * expr)) (len:nat) {struct len} : list (loc * nat * expr) :=
match len with
O => nil
| S len' =>
match l with
nil => nil
| (adr, sz, st)::tl => match (expr_eq Allocated st) with
true => (adr, sz, Allocated)::(compact' tl len')
| false =>
match tl with
nil => (adr, sz, Free)::nil
| (adr',sz',st')::tl' => match (expr_eq Allocated st) with
true => (adr, sz, Allocated)::(compact' tl len')
| false => compact' ((adr, sz+sz'+2, Free)::tl) len'
end
end
end
end
end.
Definition compact_coq_fct (l:list (loc * nat * expr)): list (loc * nat * expr) := compact' l (length l).
Inductive compact_coq_ind: (list (nat * loc * expr)) -> (list (nat * loc * expr)) -> Prop :=
compact_coq_ind_nil: compact_coq_ind nil nil
| compact_coq_ind_Alloc: forall adr size l l',
compact_coq_ind l l' ->
compact_coq_ind ((adr, size, Allocated)::l) ((adr, size, Allocated)::l')
| compact_coq_ind_last_Free: forall adr size,
compact_coq_ind ((adr, size, Free)::nil) ((adr, size, Free)::nil)
| compact_coq_ind_Free_Free: forall adr size adr' size' l l',
compact_coq_ind ((adr,size + 2 + size', Free)::l) l' ->
compact_coq_ind ((adr,size, Free)::(adr',size', Free)::l) l'
| compact_coq_ind_Free_Alloc: forall adr size adr' size' l l',
compact_coq_ind l l' ->
compact_coq_ind ((adr,size, Free)::(adr',size', Allocated)::l) ((adr,size, Free)::(adr',size', Allocated)::l').
Axiom compact_coq_ind2fct: forall l s h startl,
Heap_List l startl 0 s h ->
(forall l', compact_coq_fct l = l' <-> compact_coq_ind l l').
Inductive split_coq_ind: (list (nat * loc * expr)) -> nat -> loc -> (list (nat * loc * expr)) -> Prop :=
split_coq_ind_nil: forall n sz, split_coq_ind nil sz n nil
| split_coq_ind_Alloc: forall adr sz n size l l',
split_coq_ind l size n l' ->
split_coq_ind ((adr,sz,Allocated)::l) size n ((adr,sz,Allocated)::l')
| split_coq_ind_Free: forall adr sz l l' n size,
adr <> n ->
split_coq_ind l size n l' ->
split_coq_ind ((adr,sz,Allocated)::l) size n ((adr,sz,Allocated)::l')
| split_coq_ind_Free_split: forall adr sz l n size,
adr = n ->
sz >= size + LEFTOVER + 2 ->
split_coq_ind ((adr,sz,Free)::l) size n ((adr,size,Free)::(adr+2+size,sz-2-size,Free)::l)
| split_coq_ind_Free_split': forall adr sz l n size,
adr = n ->
sz < size + LEFTOVER + 2 ->
split_coq_ind ((adr,sz,Free)::l) size n ((adr,sz,Free)::l).
Inductive freeblocks': list (nat * loc * expr) -> Z -> Prop :=
freeblocks'_nil: freeblocks' nil 0%Z
| freeblocks'_Allocated: forall adr sz l l' n,
freeblocks' l n ->
freeblocks' (l' ++ (adr,sz,Allocated)::l) n
| freeblocks'_Free_end: forall adr sz l,
freeblocks' ((adr,sz,Allocated)::l) 0%Z
| freeblocks'_Free_suiv: forall adr sz l n,
freeblocks' l (n - (Z_of_nat sz) - 2)%Z ->
freeblocks' ((adr,sz,Free)::l) n.
Definition freeblocks (l: list (nat * loc * expr)) (n: nat) :=
freeblocks' l (Z_of_nat (n + 2)).
Inductive freeblock': list (loc * nat * expr) -> nat -> Prop :=
freeblock'_nil: freeblock' nil 0
| freeblock'_free : forall adr sz l n,
freeblock' l n ->
freeblock' ((adr,sz,Free)::l) (n+sz).
Definition freeblock (l: list (loc * nat * expr)) (n: nat):=
exists l1, exists l2, exists l', l = (l1 ++ l' ++ l2) /\ freeblock' l' n.
Definition hmAlloc_specif3 := forall l result adr size entry cptr fnd stts nptr sz,
(var.set (hmStart::result::entry::cptr::fnd::stts::nptr::sz::nil)) ->
adr > 0 -> size > 0 ->
{{fun s h => Heap_List l adr 0 s h /\
eval (var_e hmStart) s = eval (nat_e adr) s /\
exists free_size, freeblocks l free_size /\ free_size >= size
}}
hmAlloc result size entry cptr fnd stts nptr sz
{{ fun s => fun h =>
exists l',
exists y, y > 0 /\ eval (var_e result) s = Z_of_nat (y+2) /\
exists size'', size'' >= size /\
(Heap_List l adr 0 ** Array (y + 2) size'') s h /\
In (y,size'',Allocated) l /\
(
(exists l'', compact_coq_ind l l'' /\ split_coq_ind l'' size y l')
\/
(split_coq_ind l size y l')
)
}}.
Definition findFree_specif := forall adr entry fnd sz stts size sizex x result l,
size > 0 ->
sizex > 0 ->
adr > 0 ->
var.set (hmStart::entry::fnd::sz::stts::result::nil) ->
{{fun s => fun h => Heap_List l adr 0 s h /\
In (x,sizex,Allocated) l /\
eval (var_e hmStart) s = eval (nat_e adr) s /\
eval (var_e result) s = eval null s }}
findFree size entry fnd sz stts
{{fun s => fun h =>
Heap_List l adr 0 s h /\
In (x,sizex,Allocated) l /\
eval (var_e hmStart) s = eval (nat_e adr) s /\
eval (var_e result) s = eval null s /\
(
(exists finded_free_block, exists size'', size'' >= size /\
In (finded_free_block,size'',Free) l /\
eval (var_e entry) s = (Z_of_nat finded_free_block) /\
finded_free_block > 0)
\/
(eval (var_e entry) s = eval null s)
)}}.
Lemma findFree_verif : findFree_specif.
Eval_b_hyp_clean.