Commit bc776c70 authored by Ralf Jung's avatar Ralf Jung

further optimize step_by_value: Determine when we need to deal with dependant equality

parent dcd28632
...@@ -303,11 +303,10 @@ Lemma step_by_value {K K' e e'} : ...@@ -303,11 +303,10 @@ Lemma step_by_value {K K' e e'} :
e2v e = None -> e2v e = None ->
exists K'', K' = comp_ctx K K''. exists K'', K' = comp_ctx K K''.
Proof. Proof.
Ltac bad_fill Hfill := exfalso; move: Hfill; first [case_depeq3 | case_depeq2 | case_depeq1 | case] =>Hfill; Ltac bad_fill := intros; exfalso; subst;
intros; subst; (eapply values_stuck; eassumption) || (eapply fill_not_value2; first eassumption;
(eapply values_stuck; eassumption) || (eapply fill_not_value2; first eassumption; try match goal with [ H : fill _ _ = _ |- _ ] => erewrite ->H end;
try match goal with [ H : fill _ _ = _ |- _ ] => erewrite ->H end; by erewrite ?v2v).
by erewrite ?v2v).
Ltac bad_red Hfill e' Hred := exfalso; destruct e'; try discriminate Hfill; []; Ltac bad_red Hfill e' Hred := exfalso; destruct e'; try discriminate Hfill; [];
case: Hfill; intros; subst; destruct Hred as (σ' & e'' & σ'' & ef & Hstep); case: Hfill; intros; subst; destruct Hred as (σ' & e'' & σ'' & ef & Hstep);
inversion Hstep; done || (clear Hstep; subst; inversion Hstep; done || (clear Hstep; subst;
...@@ -315,7 +314,7 @@ Proof. ...@@ -315,7 +314,7 @@ Proof.
try match goal with [ H : _ = fill _ _ |- _ ] => erewrite <-H end; simpl; try match goal with [ H : _ = fill _ _ |- _ ] => erewrite <-H end; simpl;
repeat match goal with [ H : e2v _ = _ |- _ ] => erewrite H; clear H; simpl end repeat match goal with [ H : e2v _ = _ |- _ ] => erewrite H; clear H; simpl end
); eassumption || done). ); eassumption || done).
Ltac good Hfill IH := move: Hfill; first [case_depeq3 | case_depeq2 | case_depeq1 | case]; intros; subst; Ltac good IH := intros; subst;
let K'' := fresh "K''" in edestruct IH as [K'' Hcomp]; first eassumption; let K'' := fresh "K''" in edestruct IH as [K'' Hcomp]; first eassumption;
exists K''; by eauto using f_equal, f_equal2, f_equal3, v2e_inj. exists K''; by eauto using f_equal, f_equal2, f_equal3, v2e_inj.
...@@ -328,15 +327,19 @@ Proof. ...@@ -328,15 +327,19 @@ Proof.
(* Many of the other cases result in contradicting equalities. *) (* Many of the other cases result in contradicting equalities. *)
try discriminate Hfill; try discriminate Hfill;
(* The remaining cases are "compatible" contexts - that result in the same head symbol of the expression. (* The remaining cases are "compatible" contexts - that result in the same head symbol of the expression.
Test whether the context als has the same head, and use the appropriate tactic. *) Test whether the context als has the same head, and use the appropriate tactic.
match goal with Furthermore, the Op* contexts need special treatment due to the inhomogenuous equalities
| [ |- exists x, ?C _ = ?C _ ] => by good Hfill IHK they induce. *)
| [ |- exists x, ?C _ _ = ?C _ _ ] => by good Hfill IHK by match goal with
| [ |- exists x, ?C _ _ _ = ?C _ _ _ ] => by good Hfill IHK | [ |- exists x, Op1Ctx _ _ = Op1Ctx _ _ ] => move: Hfill; case_depeq2; good IHK
| [ |- exists x, ?C _ _ _ _ = ?C _ _ _ _ ] => by good Hfill IHK | [ |- exists x, Op2LCtx _ _ _ = Op2LCtx _ _ _ ] => move: Hfill; case_depeq3; good IHK
| [ |- exists x, ?C _ _ _ _ _ = ?C _ _ _ _ _ ] => by good Hfill IHK | [ |- exists x, Op2RCtx _ _ _ = Op2RCtx _ _ _ ] => move: Hfill; case_depeq3; good IHK
| [ |- exists x, ?C _ _ _ _ _ _ = ?C _ _ _ _ _ _ ] => by good Hfill IHK | [ |- exists x, ?C _ = ?C _ ] => case: Hfill; good IHK
| _ => by bad_fill Hfill | [ |- exists x, ?C _ _ = ?C _ _ ] => case: Hfill; good IHK
| [ |- exists x, ?C _ _ _ = ?C _ _ _ ] => case: Hfill; good IHK
| [ |- exists x, Op2LCtx _ _ _ = Op2RCtx _ _ _ ] => move: Hfill; case_depeq3; bad_fill
| [ |- exists x, Op2RCtx _ _ _ = Op2LCtx _ _ _ ] => move: Hfill; case_depeq3; bad_fill
| _ => case: Hfill; bad_fill
end). end).
Qed. Qed.
End step_by_value. End step_by_value.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment