Progress on porting to Coq 8.6

This commit is contained in:
Adam Chlipala 2017-02-07 18:51:05 -05:00
parent 4b3e4abb58
commit 1768aa6ea7
5 changed files with 146 additions and 42 deletions

78
Frap.v
View file

@ -19,7 +19,79 @@ Ltac inductN n :=
end end
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. 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 := Ltac inList x xs :=
match xs with match xs with
| (x, _) => constr:true | (x, _) => true
| (_, ?xs') => inList x xs' | (_, ?xs') => inList x xs'
| _ => constr:false | _ => false
end. end.
Ltac maybe_simplify_map m found kont := Ltac maybe_simplify_map m found kont :=

View file

@ -630,25 +630,26 @@ Module Stlc.
propositional. propositional.
right. right.
invert H1; invert H. (* Some automation is needed here to maintain compatibility with
invert H2; invert H0. * 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)). exists (Const (n + n0)).
eapply StepRule with (C := Hole). eapply StepRule with (C := Hole).
eauto. eauto.
eauto. eauto.
constructor. constructor.
invert H2. match goal with
right. | [ H : exists x, _ |- _ ] => invert H
invert H3. end.
exists (Plus e1 x). match goal with
eapply StepRule with (C := Plus2 e1 C). | [ H : step _ _ |- _ ] => invert H
eauto. end.
eauto.
assumption.
invert H1.
invert H3.
right. right.
exists (Plus x e2). exists (Plus x e2).
eapply StepRule with (C := Plus1 C e2). eapply StepRule with (C := Plus1 C e2).
@ -656,8 +657,25 @@ Module Stlc.
eauto. eauto.
assumption. assumption.
invert H1. match goal with
invert H3. | [ 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. right.
exists (Plus x e2). exists (Plus x e2).
eapply StepRule with (C := Plus1 C e2). eapply StepRule with (C := Plus1 C e2).
@ -671,7 +689,9 @@ Module Stlc.
propositional. propositional.
right. 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). exists (subst e2 x e0).
eapply StepRule with (C := Hole). eapply StepRule with (C := Hole).
eauto. eauto.
@ -679,17 +699,12 @@ Module Stlc.
constructor. constructor.
assumption. assumption.
invert H2. match goal with
right. | [ H : exists x, _ |- _ ] => invert H
invert H3. end.
exists (App e1 x). match goal with
eapply StepRule with (C := App2 e1 C). | [ H : step _ _ |- _ ] => invert H
eauto. end.
eauto.
assumption.
invert H1.
invert H3.
right. right.
exists (App x e2). exists (App x e2).
eapply StepRule with (C := App1 C e2). eapply StepRule with (C := App1 C e2).
@ -697,8 +712,25 @@ Module Stlc.
eauto. eauto.
assumption. assumption.
invert H1. match goal with
invert H3. | [ 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. right.
exists (App x e2). exists (App x e2).
eapply StepRule with (C := App1 C e2). eapply StepRule with (C := App1 C e2).
@ -775,10 +807,8 @@ Module Stlc.
constructor. constructor.
constructor. constructor.
apply IHhasty1. eapply IHhasty1; equality.
assumption. eapply IHhasty2; equality.
apply IHhasty2.
assumption.
cases (x0 ==v x). cases (x0 ==v x).
@ -800,10 +830,8 @@ Module Stlc.
assumption. assumption.
econstructor. econstructor.
apply IHhasty1. eapply IHhasty1; equality.
assumption. eapply IHhasty2; equality.
apply IHhasty2.
assumption.
Qed. Qed.
(* We're almost ready for the other main property. Let's prove it first (* We're almost ready for the other main property. Let's prove it first

View file

@ -813,6 +813,8 @@ Module Concurrent.
-> cstep (v, c) (v', c'). -> cstep (v, c) (v', c').
Proof. Proof.
induct 1; repeat match goal with induct 1; repeat match goal with
| [ H : forall a b c d, _ = _ -> _ = _ -> _ |- _ ] =>
specialize (H _ _ _ _ eq_refl eq_refl)
| [ H : cstep _ _ |- _ ] => invert H | [ H : cstep _ _ |- _ ] => invert H
end; eauto. end; eauto.
Qed. Qed.

View file

@ -854,7 +854,8 @@ Proof.
cases (x0 $? a); try equality. cases (x0 $? a); try equality.
eauto using lookup_Some_dom. eauto using lookup_Some_dom.
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. eauto using lookup_None_dom.
Qed. Qed.

View file

@ -1102,7 +1102,8 @@ Proof.
cases (x0 $? a); try equality. cases (x0 $? a); try equality.
eauto using lookup_Some_dom. eauto using lookup_Some_dom.
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. eauto using lookup_None_dom.
Qed. Qed.