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.