Ltac delete_skip :=
repeat apply -> semax_skip_seq;
try apply semax_skip_seq1.
Ltac forward_loop_aux2 Inv PreInc :=
lazymatch goal with
| |- semax _ _ (Sloop _ Sskip) _ =>
tryif (constr_eq Inv PreInc) then (apply (semax_loop_noincr _ Inv); abbreviate_semax)
else (apply (semax_loop _ Inv PreInc); [delete_skip | ]; abbreviate_semax)
| |- semax _ _ (Sloop _ _) _ =>apply (semax_loop _ Inv PreInc); [delete_skip | ]; abbreviate_semax
end.
Ltac forward_loop_aux1 Inv PreInc:=
lazymatch goal with
| |- semax _ _ (Sfor _ _ _ _) _ => apply semax_seq' with Inv; [abbreviate_semax | forward_loop_aux2 Inv PreInc]
| |- semax _ _ (Sloop _ _) _ => apply semax_pre with Inv; [ | forward_loop_aux2 Inv PreInc]
| |- semax _ _ (Swhile ?E ?B) _ =>
let x := fresh "x" in set (x := Swhile E B); hnf in x; subst x;
apply semax_pre with Inv; [ | forward_loop_aux2 Inv PreInc]
end.
Tactic Notation "forward_loop" constr(Inv) "continue:" constr(PreInc) "break:" constr(Post) :=
repeat simple apply seq_assoc1;
repeat apply -> semax_seq_skip;
match goal with
| |- semax _ _ (Ssequence (Sloop _ _) _) _ =>
apply semax_seq with Post; [forward_loop_aux1 Inv PreInc | abbreviate_semax ]
| |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
apply semax_seq with Post; [forward_loop_aux1 Inv PreInc | abbreviate_semax ]
| |- semax _ _ (Ssequence (Swhile _ _) _) _ =>
apply semax_seq with Post; [forward_loop_aux1 Inv PreInc | abbreviate_semax ]
| |- semax _ _ _ ?Post' =>
tryif (unify Post Post') then forward_loop_aux1 Inv PreInc
else (apply (semax_post1_flipped Post); [ forward_loop_aux1 Inv PreInc | ])
end.
Ltac check_no_incr S :=
let s' := eval hnf in S in
match s' with
| Ssequence ?x _ => check_no_incr x
| Sloop _ ?inc => let i' := eval hnf in inc in match i' with Sskip => idtac end
| Sloop _ _ => fail 100 "Your loop has an increment statement, so your forward_loop must have a continue: invariant"
| Sfor _ _ ?inc _ => let i' := eval hnf in inc in match i' with Sskip => idtac end
| Sfor _ _ _ _ => fail 100 "Your loop has an increment statement, so your forward_loop must have a continue: invariant"
| _ => fail 100 "applied forward_loop to something that is not a loop"
end.
Tactic Notation "forward_loop" constr(Inv) "continue:" constr(PreInc) :=
repeat apply -> semax_seq_skip;
lazymatch goal with
| |- semax _ _ (Ssequence (Sloop _ _) _) _ =>
fail 100 "Your loop is followed by more statements, so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop."
| |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
fail 100 "Your loop is followed by more statements, so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop."
| P := @abbreviate ret_assert ?Post' |- semax _ _ _ ?Post =>
first [constr_eq P Post | fail 100 "forward_loop failed; try doing abbreviate_semax first"];
try (has_evar Post'; fail 100 "Error: your postcondition " P " has unification variables (evars), so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop.");
forward_loop Inv continue: PreInc break: Post
| |- semax _ _ _ _ => fail 100 "forward_loop failed; try doing abbreviate_semax first"
| |- _ => fail 100 "forward_loop applicable only to a semax goal"
end.
Tactic Notation "forward_loop" constr(Inv) "break:" constr(Post) "continue:" constr(PreInc) :=
forward_loop Inv continue: PreInc break: Post.
Tactic Notation "forward_loop" :=
fail "Usage:   forward_loop Inv,     where Inv is your loop invariant".
Fixpoint quickflow (c: statement) (ok: exitkind->bool) : bool :=
match c with
| Sreturn _ => ok EK_return
| Ssequence c1 c2 =>
quickflow c1 (fun ek => match ek with
| EK_normal => quickflow c2 ok
| _ => ok ek
end)
| Sifthenelse e c1 c2 =>
andb (quickflow c1 ok) (quickflow c2 ok)
| Sloop body incr =>
andb (quickflow body (fun ek => match ek with
| EK_normal => true
| EK_break => ok EK_normal
| EK_continue => true
| EK_return => ok EK_return
end))
(quickflow incr (fun ek => match ek with
| EK_normal => true
| EK_break => ok EK_normal
| EK_continue => false
| EK_return => ok EK_return
end))
| Sbreak => ok EK_break
| Scontinue => ok EK_continue
| Sswitch _ _ => false   (* this could be made more generous *)
| Slabel _ c => quickflow c ok
| Sgoto _ => false
| _ => ok EK_normal
end.
Fixpoint nobreaksx (s: statement) : bool :=
match s with
| Sbreak => false
| Scontinue => false
| Ssequence c1 c2 => nobreaksx c1 && nobreaksx c2
| Sifthenelse _ c1 c2 => nobreaksx c1 && nobreaksx c2
| _ => true  (* including Sloop case! *)
end.
Ltac check_nocontinue s :=
let s' := eval hnf in s in
lazymatch s' with
| Ssequence ?x _ => check_nocontinue x
| Sloop ?body _ => unify (nocontinue body) true
| _ => fail 100 "applied forward_loop to something that is not a loop"
end.
Ltac forward_loop_nocontinue2 Inv :=
apply semax_loop_nocontinue; delete_skip; abbreviate_semax.
Ltac forward_loop_nocontinue1 Inv :=
lazymatch goal with
| |- semax _ _ (Sfor _ _ _ _) _ => apply semax_seq' with Inv; [abbreviate_semax | forward_loop_nocontinue2 Inv]
| |- semax _ _ (Sloop _ _) _ => apply semax_pre with Inv; [ | forward_loop_nocontinue2 Inv]
| |- semax _ _ (Swhile ?E ?B) _ =>
let x := fresh "x" in set (x := Swhile E B); unfold Swhile at 1 in x; subst x;
apply semax_pre with Inv; [ | forward_loop_nocontinue2 Inv]
end.
Ltac forward_loop_nocontinue Inv Post :=
repeat simple apply seq_assoc1;
repeat apply -> semax_seq_skip;
match goal with
| |- semax _ _ (Ssequence _ _) _ =>
apply semax_seq with Post; [forward_loop_nocontinue1 Inv  | abbreviate_semax ]
| |- semax _ _ _ ?Post' =>
tryif (unify Post Post') then forward_loop_nocontinue1 Inv
else (apply (semax_post1_flipped Post); [ forward_loop_nocontinue1 Inv  | ])
end.
Ltac forward_loop_nocontinue_nobreak Inv :=
repeat apply -> semax_seq_skip;
lazymatch goal with
| |- semax _ _ (Ssequence (Swhile _ ?S) _) _ =>
tryif (unify (nocontinue S) true; unify (nobreaksx S) true) then forward_while Inv
else fail 100 "Use forward_while, or (unfold Swhile at 1) and then use forward_loop"
| |- semax _ _ (Ssequence (Sloop _ _) _) _ =>
fail 100 "Your loop is followed by more statements, so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop."
| |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
fail 100 "Your loop is followed by more statements, so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop."
| P := @abbreviate ret_assert ?Post' |- semax _ _ _ ?Post =>
first [constr_eq P Post | fail 100 "forward_loop failed; try doing abbreviate_semax first"];
try (has_evar Post'; fail 100 "Error: your postcondition " P " has unification variables (evars), so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop.");
forward_loop_nocontinue Inv Post
| |- semax _ _ _ _ => fail 100 "forward_loop failed; try doing abbreviate_semax first"
| |- _ => fail 100 "forward_loop applicable only to a semax goal"
end.
Tactic Notation "forward_loop" constr(Inv)  :=
match goal with |- semax _ _ ?c _ =>
tryif (check_nocontinue c)
then forward_loop_nocontinue_nobreak Inv
else (check_no_incr c; forward_loop Inv continue: Inv)
end.
Tactic Notation "forward_loop" constr(Inv) "break:" constr(Post) :=
match goal with |- semax _ _ ?c _ =>
tryif (check_nocontinue c)
then forward_loop_nocontinue Inv Post
else (check_no_incr c; forward_loop Inv continue: Inv break: Post)
end.
Tactic Notation "forward_for" constr(Inv) "continue:" constr(PreInc) :=
check_Delta; check_POSTCONDITION;
repeat simple apply seq_assoc1;
lazymatch type of Inv with
| _ -> environ -> mpred => idtac
| _ => fail "Invariant (first argument to forward_for) must have type (_ -> environ -> mpred)"
end;
lazymatch type of PreInc with
| _ -> environ -> mpred => idtac
| _ => fail "PreInc (continue: argument to forward_for) must have type (_ -> environ -> mpred)"
end;
lazymatch goal with
| |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
apply -> seq_assoc;
apply semax_seq' with (exp Inv); abbreviate_semax;
[  | eapply semax_seq;
[ forward_for2 Inv PreInc
| abbreviate_semax;
apply extract_exists_pre; intro;
let HRE := fresh in
apply semax_extract_PROP; intro HRE;
repeat (apply semax_extract_PROP; fancy_intro true);
do_repr_inj HRE]
]
| |- semax _ _ (Sfor _ _ _ _) ?Post =>
apply semax_seq' with (exp Inv); abbreviate_semax;
[  | forward_for3 Inv PreInc Post]
| |- semax _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) _) _) ?Post =>
apply semax_pre with (exp Inv);
[  | forward_for3 Inv PreInc Post]
| |- semax _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) _) _) _ =>
apply semax_pre with (exp Inv);
[ unfold_function_derives_right | forward_for2 Inv PreInc ]
| |- _ => fail "forward_for2x cannot recognize the loop"
end.
Tactic Notation "forward_for" constr(Inv) "continue:" constr(PreInc) "break:" constr(Postcond) :=
check_Delta; check_POSTCONDITION;
repeat simple apply seq_assoc1;
lazymatch type of Inv with
| _ -> environ -> mpred => idtac
| _ => fail "Invariant (first argument to forward_for) must have type (_ -> environ -> mpred)"
end;
lazymatch type of PreInc with
| _ -> environ -> mpred => idtac
| _ => fail "PreInc (second argument to forward_for) must have type (_ -> environ -> mpred)"
end;
lazymatch type of Postcond with
| environ -> mpred => idtac
| _ => fail "Postcond (third argument to forward_for) must have type (environ -> mpred)"
end;
lazymatch goal with
| |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
apply -> seq_assoc;
apply semax_seq' with (exp Inv); abbreviate_semax;
[  | forward_for3 Inv PreInc Postcond]
| |- semax _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) _) _) _ =>
apply semax_pre with (exp Inv);
[ unfold_function_derives_right | forward_for3 Inv PreInc Postcond ]
end.
Tactic Notation "forward_for" constr(Inv) "break:" constr(Postcond) "continue:" constr(PreInc) :=
forward_for Inv continue: PreInc break: Postcond.
Tactic Notation "forward_for" constr(Inv) constr(PreInc) :=
fail "Usage of the forward_for tactic:
forward_for  Inv   (* where Inv: A->environ->mpred is a predicate on index values of type A *)
forward_for Inv continue: PreInc (* where Inv,PreInc are predicates on index values of type A *)
forward_for Inv continue: PreInc break:Post (* where Post: environ->mpred is an assertion *)".

(* Specifications: *)
Lemma semax_convert_for_while:
forall CS Espec Delta Pre s1 e2 s3 s4 Post,
nocontinue s4 = true ->
nocontinue s3 = true ->
@semax CS Espec Delta Pre (Ssequence s1 (Swhile e2 (Ssequence s4 s3))) Post ->
@semax CS Espec Delta Pre (Sfor s1 e2 s4 s3) Post.