Library topsy_hmAlloc2

Load seplog_header.
Require Import topsy_hm.
Require Import topsy_hmAlloc.
Require Import Bool.

Fixpoint Free_block_list (l:list nat) {struct l} : list (nat * bool) :=
  match l with
    nil => nil
    | hd::tl => (hd,true) :: Free_block_list tl
  end.

Fixpoint nat_list_sum (l:list nat) {struct l}: nat :=
  match l with
    nil => 0
    | hd::tl => hd + (nat_list_sum tl)
  end.

Definition Free_block_compact_size (l:list nat) :=
  nat_list_sum l + 2 * length l - 2.

Lemma Free_block_list_nempty: forall l,
  (Free_block_compact_size l > 0) ->
  l <> nil.

Definition findFree_specif2 := forall adr size ,
  size > 0 ->
  adr > 0 ->
    {{fun s => fun h => exists l1, exists l2, exists l,
    (Heap_List (l1 ++ (Free_block_list l) ++ l2) adr) s h /\
    (Free_block_compact_size l) >= size /\
    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 => exists l1, exists l2, exists l,
    (Heap_List (l1 ++ (Free_block_list l) ++ l2) adr) s h /\
    (Free_block_compact_size l) >= size /\
    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_hl (l1 ++ (Free_block_list l) ++ l2) (finded_free_block,size'',free) adr /\
        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_verif2: findFree_specif2.





















  Eval_b_hyp_clean.
  Eval_b_goal.









Definition compact_specif2:= forall adr size,
  size > 0 ->
  adr > 0 ->

  {{fun s => fun h => exists l1, exists l2, exists l,
    (Heap_List (l1 ++ (Free_block_list l) ++ l2) adr) s h /\
    (Free_block_compact_size l) >= size /\
    eval (var_e hmStart) s = eval (nat_e adr) s /\
    eval (var_e result) s = eval null s /\
    eval (var_e cptr) s = eval (nat_e adr) s
  }}
  
  compact cptr nptr stts
  
  {{fun s => fun h => exists l,
    (Heap_List l adr) s h /\
    eval (var_e hmStart) s = eval (nat_e adr) s /\
    eval (var_e result) s = eval null s /\
    (exists free_adr, exists free_size, free_size >= size /\
      In_hl l (free_adr, free_size, free) adr
    )
  }}.

Lemma compact_verif2: compact_specif2.






































  Eval_b_hyp H9.


  Eval_b_hyp H12.



Eval_b_hyp H11.

Eval_b_hyp H11.
Eval_b_goal.

Eval_b_hyp H11.
Eval_b_hyp H11.
Eval_b_goal.



Eval_b_hyp H12.
Eval_b_hyp H12.
Eval_b_goal.

Eval_b_hyp H12; OmegaZ.
Eval_b_hyp H12.
Eval_b_goal.

Eval_b_hyp H12.
Eval_b_hyp H12.
Eval_b_goal.




















Definition findFree_specif2' := forall adr size,
  size > 0 ->
  adr > 0 ->
  {{fun (s : store.s) (h : heap.h) =>
    exists l,
      Heap_List l adr s h /\
      eval (var_e hmStart) s = eval (nat_e adr) s /\
      eval (var_e result) s = eval null s /\
      (exists free_adr : loc,
        (exists free_size : nat,
          free_size >= size /\ In_hl l (free_adr, free_size, free) adr))}}
    findFree size entry fnd sz stts
    {{fun (s : store.s) (h : heap.h) =>
      exists l,
        Heap_List l adr s h /\
        eval (var_e hmStart) s = eval (nat_e adr) s /\
        eval (var_e result) s = eval null s /\
        (exists finded_free_block : loc,
          (exists size'' : nat,
            size'' >= size /\
            In_hl l (finded_free_block, size'', free) adr /\
            eval (var_e entry) s = Z_of_nat finded_free_block /\
            finded_free_block > 0))}}.

Lemma findFree_verif2': findFree_specif2'.




























Definition split_specif2 := forall adr size,
  size > 0 ->
  adr > 0 ->
  {{fun s => fun h => exists l,
    Heap_List l adr s h /\
    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_hl l (finded_free_block,size'',free) adr /\
      eval (var_e entry) s = (Z_of_nat finded_free_block) /\
      finded_free_block > 0) }}
  
  split entry size cptr sz
    
    {{fun s => fun h => exists l,
      (exists y, y > 0 /\ eval (var_e entry) s = Z_of_nat (y) /\
        (exists size'', size'' >= size /\
          (Heap_List l adr ** Array (y+2) size'') s h /\
          In_hl l (y,size'', alloc) adr))}}.

Lemma split_verif2: split_specif2.

























Definition hmAlloc_specif2 := forall adr size,
  adr > 0 -> size > 0 ->
  {{ fun s h => exists l1, exists l2, exists l,
    (Heap_List (l1 ++ (Free_block_list l) ++ l2) adr) s h /\
    Free_block_compact_size l >= size /\
    (s |b= var_e hmStart == nat_e adr) }}
  
  hmAlloc result size entry cptr fnd stts nptr sz
  
  {{ fun s h => exists l, exists y,
    y > 0 /\ (s |b= var_e result == nat_e (y+2)) /\
    exists size'', size'' >= size /\
      (Heap_List l adr ** Array (y + 2) size'') s h /\
      In_hl l (y,size'',alloc) adr
  }}.

Lemma hmAlloc_verif2: hmAlloc_specif2.