mirror of
https://github.com/achlipala/frap.git
synced 2024-09-19 19:57:13 +00:00
Progress on porting to Coq 8.6
This commit is contained in:
Adam Chlipala
parent
4b3e4abb58
commit
1768aa6ea7
5 changed files with 146 additions and 42 deletions
78
Frap.v
78
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 :=
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue