diff --git a/Frap.v b/Frap.v index d50fa8e..979aa21 100644 --- a/Frap.v +++ b/Frap.v @@ -19,7 +19,79 @@ Ltac inductN n := end end. -Ltac induct e := inductN e || dependent induction e. +Ltac same_structure x y := + match x with + | ?f ?a1 ?b1 ?c1 ?d1 => + match y with + | f ?a2 ?b2 ?c2 ?d2 => same_structure a1 a2; same_structure b1 b2; same_structure c1 c2; same_structure d1 d2 + | _ => fail 2 + end + | ?f ?a1 ?b1 ?c1 => + match y with + | f ?a2 ?b2 ?c2 => same_structure a1 a2; same_structure b1 b2; same_structure c1 c2 + | _ => fail 2 + end + | ?f ?a1 ?b1 => + match y with + | f ?a2 ?b2 => same_structure a1 a2; same_structure b1 b2 + | _ => fail 2 + end + | ?f ?a1 => + match y with + | f ?a2 => same_structure a1 a2 + | _ => fail 2 + end + | _ => + match y with + | ?f ?a1 ?b1 ?c1 ?d1 => + match x with + | f ?a2 ?b2 ?c2 ?d2 => same_structure a1 a2; same_structure b1 b2; same_structure c1 c2; same_structure d1 d2 + | _ => fail 2 + end + | ?f ?a1 ?b1 ?c1 => + match x with + | f ?a2 ?b2 ?c2 => same_structure a1 a2; same_structure b1 b2; same_structure c1 c2 + | _ => fail 2 + end + | ?f ?a1 ?b1 => + match x with + | f ?a2 ?b2 => same_structure a1 a2; same_structure b1 b2 + | _ => fail 2 + end + | ?f ?a1 => + match x with + | f ?a2 => same_structure a1 a2 + | _ => fail 2 + end + | _ => idtac + end + end. + +Ltac instantiate_obvious1 H := + match type of H with + | ?x = ?y -> _ => + (same_structure x y; specialize (H eq_refl)) || fail 3 + | JMeq.JMeq ?x ?y -> _ => + (same_structure x y; specialize (H JMeq.JMeq_refl)) || fail 3 + | forall x : ?T, _ => + match type of T with + | Prop => fail 1 + | _ => + let x' := fresh x in + evar (x' : T); + let x'' := eval unfold x' in x' in specialize (H x''); clear x'; + instantiate_obvious1 H + end + end. + +Ltac instantiate_obvious H := repeat instantiate_obvious1 H. + +Ltac instantiate_obviouses := + repeat match goal with + | [ H : _ |- _ ] => instantiate_obvious H + end. + +Ltac induct e := (inductN e || dependent induction e); instantiate_obviouses. Ltac invert' H := inversion H; clear H; subst. @@ -244,9 +316,9 @@ Ltac total_ordering N M := destruct (totally_ordered N M). Ltac inList x xs := match xs with - | (x, _) => constr:true + | (x, _) => true | (_, ?xs') => inList x xs' - | _ => constr:false + | _ => false end. Ltac maybe_simplify_map m found kont := diff --git a/LambdaCalculusAndTypeSoundness.v b/LambdaCalculusAndTypeSoundness.v index 19d535b..7738cda 100644 --- a/LambdaCalculusAndTypeSoundness.v +++ b/LambdaCalculusAndTypeSoundness.v @@ -630,25 +630,26 @@ Module Stlc. propositional. right. - invert H1; invert H. - invert H2; invert H0. + (* Some automation is needed here to maintain compatibility with + * name generation in different Coq versions. *) + match goal with + | [ H1 : value e1, H2 : hasty $0 e1 _ |- _ ] => invert H1; invert H2 + end. + match goal with + | [ H1 : value e2, H2 : hasty $0 e2 _ |- _ ] => invert H1; invert H2 + end. exists (Const (n + n0)). eapply StepRule with (C := Hole). eauto. eauto. constructor. - invert H2. - right. - invert H3. - exists (Plus e1 x). - eapply StepRule with (C := Plus2 e1 C). - eauto. - eauto. - assumption. - - invert H1. - invert H3. + match goal with + | [ H : exists x, _ |- _ ] => invert H + end. + match goal with + | [ H : step _ _ |- _ ] => invert H + end. right. exists (Plus x e2). eapply StepRule with (C := Plus1 C e2). @@ -656,8 +657,25 @@ Module Stlc. eauto. assumption. - invert H1. - invert H3. + match goal with + | [ H : exists x, _ |- _ ] => invert H + end. + match goal with + | [ H : step _ _ |- _ ] => invert H + end. + right. + exists (Plus e1 x). + eapply StepRule with (C := Plus2 e1 C). + eauto. + eauto. + assumption. + + match goal with + | [ H : exists x, step e1 _ |- _ ] => invert H + end. + match goal with + | [ H : step _ _ |- _ ] => invert H + end. right. exists (Plus x e2). eapply StepRule with (C := Plus1 C e2). @@ -671,7 +689,9 @@ Module Stlc. propositional. right. - invert H1; invert H. + match goal with + | [ H1 : value e1, H2 : hasty $0 e1 _ |- _ ] => invert H1; invert H2 + end. exists (subst e2 x e0). eapply StepRule with (C := Hole). eauto. @@ -679,17 +699,12 @@ Module Stlc. constructor. assumption. - invert H2. - right. - invert H3. - exists (App e1 x). - eapply StepRule with (C := App2 e1 C). - eauto. - eauto. - assumption. - - invert H1. - invert H3. + match goal with + | [ H : exists x, _ |- _ ] => invert H + end. + match goal with + | [ H : step _ _ |- _ ] => invert H + end. right. exists (App x e2). eapply StepRule with (C := App1 C e2). @@ -697,8 +712,25 @@ Module Stlc. eauto. assumption. - invert H1. - invert H3. + match goal with + | [ H : exists x, _ |- _ ] => invert H + end. + match goal with + | [ H : step _ _ |- _ ] => invert H + end. + right. + exists (App e1 x). + eapply StepRule with (C := App2 e1 C). + eauto. + eauto. + assumption. + + match goal with + | [ H : exists x, step e1 _ |- _ ] => invert H + end. + match goal with + | [ H : step _ _ |- _ ] => invert H + end. right. exists (App x e2). eapply StepRule with (C := App1 C e2). @@ -775,10 +807,8 @@ Module Stlc. constructor. constructor. - apply IHhasty1. - assumption. - apply IHhasty2. - assumption. + eapply IHhasty1; equality. + eapply IHhasty2; equality. cases (x0 ==v x). @@ -800,10 +830,8 @@ Module Stlc. assumption. econstructor. - apply IHhasty1. - assumption. - apply IHhasty2. - assumption. + eapply IHhasty1; equality. + eapply IHhasty2; equality. Qed. (* We're almost ready for the other main property. Let's prove it first diff --git a/OperationalSemantics_template.v b/OperationalSemantics_template.v index 305b315..cc915b9 100644 --- a/OperationalSemantics_template.v +++ b/OperationalSemantics_template.v @@ -813,6 +813,8 @@ Module Concurrent. -> cstep (v, c) (v', c'). Proof. induct 1; repeat match goal with + | [ H : forall a b c d, _ = _ -> _ = _ -> _ |- _ ] => + specialize (H _ _ _ _ eq_refl eq_refl) | [ H : cstep _ _ |- _ ] => invert H end; eauto. Qed. diff --git a/SeparationLogic.v b/SeparationLogic.v index 6227be7..a2f15eb 100644 --- a/SeparationLogic.v +++ b/SeparationLogic.v @@ -854,7 +854,8 @@ Proof. cases (x0 $? a); try equality. eauto using lookup_Some_dom. eauto using lookup_Some_dom. - rewrite lookup_join2 in H8; eauto. + rewrite lookup_join2 in H8. + eapply H2; eassumption. eauto using lookup_None_dom. Qed. diff --git a/SeparationLogic_template.v b/SeparationLogic_template.v index 70ffa11..be0c146 100644 --- a/SeparationLogic_template.v +++ b/SeparationLogic_template.v @@ -1102,7 +1102,8 @@ Proof. cases (x0 $? a); try equality. eauto using lookup_Some_dom. eauto using lookup_Some_dom. - rewrite lookup_join2 in H8; eauto. + rewrite lookup_join2 in H8. + eapply H2; eassumption. eauto using lookup_None_dom. Qed.