Local Open Scope logic.
Instance LS: listspec t_struct_list _tail.
intros.
split; induction l1; intros.
inv H. destruct l2; inv H0. auto.
split. auto. simpl in H2. inv H2.
constructor; auto.
split. inv H. constructor; auto. apply IHl1 in H3.
intuition.
inv H. apply IHl1 in H3. intuition.
simpl. intuition.
simpl. constructor.
destruct H. inv H. auto.
apply IHl1. intuition.
inv H0; auto.
Qed.
Ltac destruct_ptr :=
match goal with
| [ H: isptr (?X) |- _] => let v := fresh "pt" in (remember X as v; destruct v; inv H)
end.
intros.
induction l.
auto.
simpl.
rewrite insert_reorder. rewrite IHl. auto.
Qed.
rewrite insert_insertion_sort. cancel.
unfold body_post.
forward_intro sorted_list.
forward.
apply exp_right with sorted.
entailer!.
Qed.
apply insert_value_right in H1. subst. rewrite H1.
apply derives_trans with
(list_cell LS sh insert_node insert_value *
field_at sh t_struct_list _tail insert_node nullval *
lseg LS sh (contents_lt ++ [prev_val]) sorted insert_node).
cancel. rewrite lseg_eq. normalize. simpl. auto.
apply @lseg_cons_right_null.
simpl in *.
fold t_struct_list.
rewrite H6 in H4.
clear H6. unfold logical_and_result, typed_false in H4.
simpl in H4. rewrite <- H5 in H4. remember (Int.lt sorted_val insert_value).
destruct b0; inv H4.
induction contents_lt;
intros. repeat rewrite app_nil_l.
simpl. rewrite <- H0. auto.
auto.
inv H. simpl.
remember (Int.lt a insert_value).
destruct b. simpl. rewrite IHcontents_lt; auto.
unfold Igt in *. clear - H3 Heqb.
replace (Int.lt a insert_value) with
(Int.cmp Clt a insert_value) in * by auto.
rewrite <- Int.swap_cmp in Heqb. simpl swap_comparison in Heqb. congruence.
Qed.
rewrite app_cons.
rewrite insert_value_result.
apply derives_trans with
( list_cell LS sh (Vptr b i) sorted_val *
field_at sh t_struct_list _tail (Vptr b i) next_ptr *
lseg LS sh (contents_lt ++ [prev_val]) sorted insert_node *
lseg LS sh contents_rest next_ptr nullval *
field_at sh t_struct_list _head insert_node (Vint insert_value) *
field_at sh t_struct_list _tail insert_node (Vptr b i)
).
remember (field_at sh t_struct_list _tail insert_node (Vptr b i)).
rewrite Heqm at 1.
cancel.
rewrite Heqm.
eapply derives_trans with
( list_cell LS sh (eval_id _previous rho) prev_val *
field_at sh t_struct_list _tail (eval_id _previous rho) insert_node *
lseg LS sh contents_lt sorted (eval_id _previous rho) *
field_at sh t_struct_list _tail insert_node (Vptr b i)).
cancel.
apply @lseg_cons_right_neq.
apply derives_trans with
(  lseg LS sh (contents_lt ++ [prev_val]) sorted insert_node *
lseg LS sh (sorted_val :: contents_rest) (Vptr b i) nullval *
field_at sh t_struct_list _head insert_node (Vint insert_value) *
field_at sh t_struct_list _tail insert_node (Vptr b i)).
cancel.
rewrite lseg_unfold with (contents :=sorted_val :: contents_rest).
entailer!. apply (exp_right next_ptr).
entailer!.
rewrite <- list_cell_eq.
apply derives_trans with
( lseg LS sh (contents_lt ++ [prev_val]) sorted insert_node *
lseg LS sh (insert_value :: sorted_val :: contents_rest) insert_node nullval ).
cancel.
rewrite lseg_unfold with (contents := insert_value :: sorted_val :: contents_rest).
entailer.
apply (exp_right (Vptr b i)).
entailer!. destruct insert_node; inv Pinsert_node.
unfold ptr_eq. simpl. auto.
admit. (*believable, need lseg append lemma*) auto. auto.
}
(*skip*)
{
apply sequential'.
eapply semax_post_flipped.
eapply semax_skip.
intros. apply andp_left2.
apply normal_ret_assert_derives'.
entailer!; rewrite H2 in *; simpl in *; auto.
unfold typed_false, nullval. auto.
}
abbreviate_semax.
forward.
entailer.
destruct index; inv TC1; simpl in *.
fold t_struct_list. subst. simpl.
fold nullval.
Check lseg_neq.
rewrite lseg_neq with (s := [insert_value]).
unfold lseg_cons. apply andp_right. destruct_ptr.
entailer.
apply (exp_right insert_value). apply (exp_right nil).
apply (exp_right nullval).
entailer!.
apply now_later.
destruct insert_node; inv Pinsert_node; unfold ptr_neq; auto.
fold t_struct_list.
subst.
rewrite <- (app_nil_l (sorted_val :: contents_rest)).
rewrite insert_value_result. simpl.
apply derives_trans with
(  lseg LS sh (sorted_val :: contents_rest) (Vptr b i) nullval *
field_at sh t_struct_list _head insert_node (Vint insert_value) *
field_at sh t_struct_list _tail insert_node (Vptr b i)
).
cancel.
rewrite lseg_unfold with (contents := (sorted_val :: contents_rest)).
entailer. apply (exp_right next_ptr).
entailer!. rewrite <- list_cell_eq.
apply derives_trans with
(  list_cell LS sh insert_node insert_value *
field_at sh t_struct_list _tail insert_node (Vptr b i) *
lseg LS sh (sorted_val :: contents_rest) (Vptr b i) nullval
) .
cancel.
rewrite lseg_unfold with (contents := (insert_value :: sorted_val :: contents_rest)).
entailer. apply (exp_right (Vptr b i)).
entailer!. destruct insert_node; intuition.
constructor.
rewrite H6 in *.
clear H6.
rewrite <- H5 in *.
simpl in H4.
unfold typed_false, logical_and_result in *.
simpl in H4. destruct (Int.lt sorted_val insert_value); inv H4; auto.
}
Qed.

Lemma sorted_sound : forall xs, sorted xs = true <-> LocallySorted Z.le xs.